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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.LayoutManager.LayoutManager' structure contains only private data
-- and should be accessed using the provided API
-- 
-- /Since: 1.2/

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

module GI.Clutter.Objects.LayoutManager
    ( 
#if defined(ENABLE_OVERLOADING)
    LayoutManagerListChildPropertiesMethodInfo,
#endif

-- * Exported types
    LayoutManager(..)                       ,
    IsLayoutManager                         ,
    toLayoutManager                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [allocate]("GI.Clutter.Objects.LayoutManager#g:method:allocate"), [beginAnimation]("GI.Clutter.Objects.LayoutManager#g:method:beginAnimation"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childGetProperty]("GI.Clutter.Objects.LayoutManager#g:method:childGetProperty"), [childSetProperty]("GI.Clutter.Objects.LayoutManager#g:method:childSetProperty"), [endAnimation]("GI.Clutter.Objects.LayoutManager#g:method:endAnimation"), [findChildProperty]("GI.Clutter.Objects.LayoutManager#g:method:findChildProperty"), [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"), [layoutChanged]("GI.Clutter.Objects.LayoutManager#g:method:layoutChanged"), [listChildProperties]("GI.Clutter.Objects.LayoutManager#g:method:listChildProperties"), [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
-- [getAnimationProgress]("GI.Clutter.Objects.LayoutManager#g:method:getAnimationProgress"), [getChildMeta]("GI.Clutter.Objects.LayoutManager#g:method:getChildMeta"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPreferredHeight]("GI.Clutter.Objects.LayoutManager#g:method:getPreferredHeight"), [getPreferredWidth]("GI.Clutter.Objects.LayoutManager#g:method:getPreferredWidth"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setContainer]("GI.Clutter.Objects.LayoutManager#g:method:setContainer"), [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)
    ResolveLayoutManagerMethod              ,
#endif

-- ** allocate #method:allocate#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerAllocateMethodInfo         ,
#endif
    layoutManagerAllocate                   ,


-- ** beginAnimation #method:beginAnimation#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerBeginAnimationMethodInfo   ,
#endif
    layoutManagerBeginAnimation             ,


-- ** childGetProperty #method:childGetProperty#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerChildGetPropertyMethodInfo ,
#endif
    layoutManagerChildGetProperty           ,


-- ** childSetProperty #method:childSetProperty#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerChildSetPropertyMethodInfo ,
#endif
    layoutManagerChildSetProperty           ,


-- ** endAnimation #method:endAnimation#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerEndAnimationMethodInfo     ,
#endif
    layoutManagerEndAnimation               ,


-- ** findChildProperty #method:findChildProperty#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerFindChildPropertyMethodInfo,
#endif
    layoutManagerFindChildProperty          ,


-- ** getAnimationProgress #method:getAnimationProgress#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetAnimationProgressMethodInfo,
#endif
    layoutManagerGetAnimationProgress       ,


-- ** getChildMeta #method:getChildMeta#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetChildMetaMethodInfo     ,
#endif
    layoutManagerGetChildMeta               ,


-- ** getPreferredHeight #method:getPreferredHeight#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetPreferredHeightMethodInfo,
#endif
    layoutManagerGetPreferredHeight         ,


-- ** getPreferredWidth #method:getPreferredWidth#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerGetPreferredWidthMethodInfo,
#endif
    layoutManagerGetPreferredWidth          ,


-- ** layoutChanged #method:layoutChanged#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerLayoutChangedMethodInfo    ,
#endif
    layoutManagerLayoutChanged              ,


-- ** setContainer #method:setContainer#

#if defined(ENABLE_OVERLOADING)
    LayoutManagerSetContainerMethodInfo     ,
#endif
    layoutManagerSetContainer               ,




 -- * Signals


-- ** layoutChanged #signal:layoutChanged#

    LayoutManagerLayoutChangedCallback      ,
#if defined(ENABLE_OVERLOADING)
    LayoutManagerLayoutChangedSignalInfo    ,
#endif
    afterLayoutManagerLayoutChanged         ,
    onLayoutManagerLayoutChanged            ,




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

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

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

foreign import ccall "clutter_layout_manager_get_type"
    c_clutter_layout_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject LayoutManager where
    glibType :: IO GType
glibType = IO GType
c_clutter_layout_manager_get_type

instance B.Types.GObject LayoutManager

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveLayoutManagerMethod (t :: Symbol) (o :: *) :: * where
    ResolveLayoutManagerMethod "allocate" o = LayoutManagerAllocateMethodInfo
    ResolveLayoutManagerMethod "beginAnimation" o = LayoutManagerBeginAnimationMethodInfo
    ResolveLayoutManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveLayoutManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveLayoutManagerMethod "childGetProperty" o = LayoutManagerChildGetPropertyMethodInfo
    ResolveLayoutManagerMethod "childSetProperty" o = LayoutManagerChildSetPropertyMethodInfo
    ResolveLayoutManagerMethod "endAnimation" o = LayoutManagerEndAnimationMethodInfo
    ResolveLayoutManagerMethod "findChildProperty" o = LayoutManagerFindChildPropertyMethodInfo
    ResolveLayoutManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveLayoutManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveLayoutManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveLayoutManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveLayoutManagerMethod "layoutChanged" o = LayoutManagerLayoutChangedMethodInfo
    ResolveLayoutManagerMethod "listChildProperties" o = LayoutManagerListChildPropertiesMethodInfo
    ResolveLayoutManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveLayoutManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveLayoutManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveLayoutManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveLayoutManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveLayoutManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveLayoutManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveLayoutManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveLayoutManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveLayoutManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveLayoutManagerMethod "getAnimationProgress" o = LayoutManagerGetAnimationProgressMethodInfo
    ResolveLayoutManagerMethod "getChildMeta" o = LayoutManagerGetChildMetaMethodInfo
    ResolveLayoutManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveLayoutManagerMethod "getPreferredHeight" o = LayoutManagerGetPreferredHeightMethodInfo
    ResolveLayoutManagerMethod "getPreferredWidth" o = LayoutManagerGetPreferredWidthMethodInfo
    ResolveLayoutManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveLayoutManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveLayoutManagerMethod "setContainer" o = LayoutManagerSetContainerMethodInfo
    ResolveLayoutManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveLayoutManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveLayoutManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveLayoutManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal LayoutManager::layout-changed
-- | The [layoutChanged](#g:signal:layoutChanged) signal is emitted each time a layout manager
-- has been changed. Every t'GI.Clutter.Objects.Actor.Actor' using the /@manager@/ instance
-- as a layout manager should connect a handler to the [layoutChanged](#g:signal:layoutChanged)
-- signal and queue a relayout on themselves:
-- 
-- >
-- >  static void layout_changed (ClutterLayoutManager *manager,
-- >                              ClutterActor         *self)
-- >  {
-- >    clutter_actor_queue_relayout (self);
-- >  }
-- >  ...
-- >    self->manager = g_object_ref_sink (manager);
-- >    g_signal_connect (self->manager, "layout-changed",
-- >                      G_CALLBACK (layout_changed),
-- >                      self);
-- 
-- 
-- Sub-classes of t'GI.Clutter.Objects.LayoutManager.LayoutManager' that implement a layout that
-- can be controlled or changed using parameters should emit the
-- [layoutChanged](#g:signal:layoutChanged) signal whenever one of the parameters changes,
-- by using 'GI.Clutter.Objects.LayoutManager.layoutManagerLayoutChanged'.
-- 
-- /Since: 1.2/
type LayoutManagerLayoutChangedCallback =
    IO ()

type C_LayoutManagerLayoutChangedCallback =
    Ptr LayoutManager ->                    -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_LayoutManagerLayoutChangedCallback :: 
    GObject a => (a -> LayoutManagerLayoutChangedCallback) ->
    C_LayoutManagerLayoutChangedCallback
wrap_LayoutManagerLayoutChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_LayoutManagerLayoutChangedCallback
wrap_LayoutManagerLayoutChangedCallback a -> IO ()
gi'cb Ptr LayoutManager
gi'selfPtr Ptr ()
_ = do
    Ptr LayoutManager -> (LayoutManager -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr LayoutManager
gi'selfPtr ((LayoutManager -> IO ()) -> IO ())
-> (LayoutManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LayoutManager
gi'self -> a -> IO ()
gi'cb (LayoutManager -> a
Coerce.coerce LayoutManager
gi'self) 


-- | Connect a signal handler for the [layoutChanged](#signal:layoutChanged) 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' layoutManager #layoutChanged callback
-- @
-- 
-- 
onLayoutManagerLayoutChanged :: (IsLayoutManager a, MonadIO m) => a -> ((?self :: a) => LayoutManagerLayoutChangedCallback) -> m SignalHandlerId
onLayoutManagerLayoutChanged :: forall a (m :: * -> *).
(IsLayoutManager a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onLayoutManagerLayoutChanged a
obj (?self::a) => IO ()
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 -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_LayoutManagerLayoutChangedCallback
wrapped' = (a -> IO ()) -> C_LayoutManagerLayoutChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_LayoutManagerLayoutChangedCallback
wrap_LayoutManagerLayoutChangedCallback a -> IO ()
wrapped
    FunPtr C_LayoutManagerLayoutChangedCallback
wrapped'' <- C_LayoutManagerLayoutChangedCallback
-> IO (FunPtr C_LayoutManagerLayoutChangedCallback)
mk_LayoutManagerLayoutChangedCallback C_LayoutManagerLayoutChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayoutManagerLayoutChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"layout-changed" FunPtr C_LayoutManagerLayoutChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [layoutChanged](#signal:layoutChanged) 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' layoutManager #layoutChanged 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.
-- 
afterLayoutManagerLayoutChanged :: (IsLayoutManager a, MonadIO m) => a -> ((?self :: a) => LayoutManagerLayoutChangedCallback) -> m SignalHandlerId
afterLayoutManagerLayoutChanged :: forall a (m :: * -> *).
(IsLayoutManager a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterLayoutManagerLayoutChanged a
obj (?self::a) => IO ()
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 -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_LayoutManagerLayoutChangedCallback
wrapped' = (a -> IO ()) -> C_LayoutManagerLayoutChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_LayoutManagerLayoutChangedCallback
wrap_LayoutManagerLayoutChangedCallback a -> IO ()
wrapped
    FunPtr C_LayoutManagerLayoutChangedCallback
wrapped'' <- C_LayoutManagerLayoutChangedCallback
-> IO (FunPtr C_LayoutManagerLayoutChangedCallback)
mk_LayoutManagerLayoutChangedCallback C_LayoutManagerLayoutChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayoutManagerLayoutChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"layout-changed" FunPtr C_LayoutManagerLayoutChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data LayoutManagerLayoutChangedSignalInfo
instance SignalInfo LayoutManagerLayoutChangedSignalInfo where
    type HaskellCallbackType LayoutManagerLayoutChangedSignalInfo = LayoutManagerLayoutChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_LayoutManagerLayoutChangedCallback cb
        cb'' <- mk_LayoutManagerLayoutChangedCallback cb'
        connectSignalFunPtr obj "layout-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.LayoutManager::layout-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-LayoutManager.html#g:signal:layoutChanged"})

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method LayoutManager::allocate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterContainer using @manager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #ClutterActorBox containing the allocated area\n  of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "AllocationFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the allocation flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_layout_manager_allocate" clutter_layout_manager_allocate :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    Ptr Clutter.Container.Container ->      -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.ActorBox.ActorBox ->        -- allocation : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Clutter", name = "AllocationFlags"})
    IO ()

-- | Allocates the children of /@container@/ given an area
-- 
-- See also 'GI.Clutter.Objects.Actor.actorAllocate'
-- 
-- /Since: 1.2/
layoutManagerAllocate ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@container@/: the t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> Clutter.ActorBox.ActorBox
    -- ^ /@allocation@/: the t'GI.Clutter.Structs.ActorBox.ActorBox' containing the allocated area
    --   of /@container@/
    -> [Clutter.Flags.AllocationFlags]
    -- ^ /@flags@/: the allocation flags
    -> m ()
layoutManagerAllocate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b) =>
a -> b -> ActorBox -> [AllocationFlags] -> m ()
layoutManagerAllocate a
manager b
container ActorBox
allocation [AllocationFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
container' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
container
    Ptr ActorBox
allocation' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
allocation
    let flags' :: CUInt
flags' = [AllocationFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AllocationFlags]
flags
    Ptr LayoutManager
-> Ptr Container -> Ptr ActorBox -> CUInt -> IO ()
clutter_layout_manager_allocate Ptr LayoutManager
manager' Ptr Container
container' Ptr ActorBox
allocation' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
container
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
allocation
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayoutManagerAllocateMethodInfo
instance (signature ~ (b -> Clutter.ActorBox.ActorBox -> [Clutter.Flags.AllocationFlags] -> m ()), MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) => O.OverloadedMethod LayoutManagerAllocateMethodInfo a signature where
    overloadedMethod = layoutManagerAllocate

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


#endif

-- method LayoutManager::begin_animation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the duration of the animation, in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the easing mode of the animation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Alpha" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_layout_manager_begin_animation" clutter_layout_manager_begin_animation :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    Word32 ->                               -- duration : TBasicType TUInt
    CULong ->                               -- mode : TBasicType TULong
    IO (Ptr Clutter.Alpha.Alpha)

{-# DEPRECATED layoutManagerBeginAnimation ["(Since version 1.12)"] #-}
-- | Begins an animation of /@duration@/ milliseconds, using the provided
-- easing /@mode@/
-- 
-- The easing mode can be specified either as a t'GI.Clutter.Enums.AnimationMode'
-- or as a logical id returned by @/clutter_alpha_register_func()/@
-- 
-- The result of this function depends on the /@manager@/ implementation
-- 
-- /Since: 1.2/
layoutManagerBeginAnimation ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> Word32
    -- ^ /@duration@/: the duration of the animation, in milliseconds
    -> CULong
    -- ^ /@mode@/: the easing mode of the animation
    -> m Clutter.Alpha.Alpha
    -- ^ __Returns:__ The t'GI.Clutter.Objects.Alpha.Alpha' created by the
    --   layout manager; the returned instance is owned by the layout
    --   manager and should not be unreferenced
layoutManagerBeginAnimation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutManager a) =>
a -> Word32 -> SignalHandlerId -> m Alpha
layoutManagerBeginAnimation a
manager Word32
duration SignalHandlerId
mode = IO Alpha -> m Alpha
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Alpha
result <- Ptr LayoutManager -> Word32 -> SignalHandlerId -> IO (Ptr Alpha)
clutter_layout_manager_begin_animation Ptr LayoutManager
manager' Word32
duration SignalHandlerId
mode
    Text -> Ptr Alpha -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutManagerBeginAnimation" Ptr Alpha
result
    Alpha
result' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Clutter.Alpha.Alpha) Ptr Alpha
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    Alpha -> IO Alpha
forall (m :: * -> *) a. Monad m => a -> m a
return Alpha
result'

#if defined(ENABLE_OVERLOADING)
data LayoutManagerBeginAnimationMethodInfo
instance (signature ~ (Word32 -> CULong -> m Clutter.Alpha.Alpha), MonadIO m, IsLayoutManager a) => O.OverloadedMethod LayoutManagerBeginAnimationMethodInfo a signature where
    overloadedMethod = layoutManagerBeginAnimation

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


#endif

-- method LayoutManager::child_get_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer using @manager"
--                 , 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 child of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue with the value of the property to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_layout_manager_child_get_property" clutter_layout_manager_child_get_property :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    Ptr Clutter.Container.Container ->      -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Gets a property on the t'GI.Clutter.Objects.LayoutMeta.LayoutMeta' created by /@manager@/ and
-- attached to a child of /@container@/
-- 
-- The t'GI.GObject.Structs.Value.Value' must already be initialized to the type of the property
-- and has to be unset with 'GI.GObject.Structs.Value.valueUnset' after extracting the real
-- value out of it
-- 
-- /Since: 1.2/
layoutManagerChildGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b, Clutter.Actor.IsActor c) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> c
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor' child of /@container@/
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to get
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' with the value of the property to get
    -> m ()
layoutManagerChildGetProperty :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b,
 IsActor c) =>
a -> b -> c -> Text -> GValue -> m ()
layoutManagerChildGetProperty a
manager b
container c
actor Text
propertyName 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
container' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
container
    Ptr Actor
actor' <- c -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
actor
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr LayoutManager
-> Ptr Container -> Ptr Actor -> CString -> Ptr GValue -> IO ()
clutter_layout_manager_child_get_property Ptr LayoutManager
manager' Ptr Container
container' Ptr Actor
actor' CString
propertyName' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
container
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
actor
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method LayoutManager::child_set_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer using @manager"
--                 , 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 child of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to 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 "a #GValue with the value of the property to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_layout_manager_child_set_property" clutter_layout_manager_child_set_property :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    Ptr Clutter.Container.Container ->      -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets a property on the t'GI.Clutter.Objects.LayoutMeta.LayoutMeta' created by /@manager@/ and
-- attached to a child of /@container@/
-- 
-- /Since: 1.2/
layoutManagerChildSetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b, Clutter.Actor.IsActor c) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> c
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor' child of /@container@/
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to set
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' with the value of the property to set
    -> m ()
layoutManagerChildSetProperty :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b,
 IsActor c) =>
a -> b -> c -> Text -> GValue -> m ()
layoutManagerChildSetProperty a
manager b
container c
actor Text
propertyName 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
container' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
container
    Ptr Actor
actor' <- c -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
actor
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr LayoutManager
-> Ptr Container -> Ptr Actor -> CString -> Ptr GValue -> IO ()
clutter_layout_manager_child_set_property Ptr LayoutManager
manager' Ptr Container
container' Ptr Actor
actor' CString
propertyName' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
container
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
actor
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

foreign import ccall "clutter_layout_manager_end_animation" clutter_layout_manager_end_animation :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    IO ()

{-# DEPRECATED layoutManagerEndAnimation ["(Since version 1.12)"] #-}
-- | Ends an animation started by 'GI.Clutter.Objects.LayoutManager.layoutManagerBeginAnimation'
-- 
-- The result of this call depends on the /@manager@/ implementation
-- 
-- /Since: 1.2/
layoutManagerEndAnimation ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> m ()
layoutManagerEndAnimation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutManager a) =>
a -> m ()
layoutManagerEndAnimation a
manager = 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr LayoutManager -> IO ()
clutter_layout_manager_end_animation Ptr LayoutManager
manager'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayoutManagerEndAnimationMethodInfo
instance (signature ~ (m ()), MonadIO m, IsLayoutManager a) => O.OverloadedMethod LayoutManagerEndAnimationMethodInfo a signature where
    overloadedMethod = layoutManagerEndAnimation

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


#endif

-- method LayoutManager::find_child_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property"
--                 , 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_layout_manager_find_child_property" clutter_layout_manager_find_child_property :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GParamSpec)

-- | Retrieves the t'GI.GObject.Objects.ParamSpec.ParamSpec' for the layout property /@name@/ inside
-- the t'GI.Clutter.Objects.LayoutMeta.LayoutMeta' sub-class used by /@manager@/
-- 
-- /Since: 1.2/
layoutManagerFindChildProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> T.Text
    -- ^ /@name@/: the name of the property
    -> m GParamSpec
    -- ^ __Returns:__ a t'GI.GObject.Objects.ParamSpec.ParamSpec' describing the property,
    --   or 'P.Nothing' if no property with that name exists. The returned
    --   t'GI.GObject.Objects.ParamSpec.ParamSpec' is owned by the layout manager and should not be
    --   modified or freed
layoutManagerFindChildProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutManager a) =>
a -> Text -> m GParamSpec
layoutManagerFindChildProperty a
manager Text
name = 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GParamSpec
result <- Ptr LayoutManager -> CString -> IO (Ptr GParamSpec)
clutter_layout_manager_find_child_property Ptr LayoutManager
manager' CString
name'
    Text -> Ptr GParamSpec -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutManagerFindChildProperty" Ptr GParamSpec
result
    GParamSpec
result' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    GParamSpec -> IO GParamSpec
forall (m :: * -> *) a. Monad m => a -> m a
return GParamSpec
result'

#if defined(ENABLE_OVERLOADING)
data LayoutManagerFindChildPropertyMethodInfo
instance (signature ~ (T.Text -> m GParamSpec), MonadIO m, IsLayoutManager a) => O.OverloadedMethod LayoutManagerFindChildPropertyMethodInfo a signature where
    overloadedMethod = layoutManagerFindChildProperty

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


#endif

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

foreign import ccall "clutter_layout_manager_get_animation_progress" clutter_layout_manager_get_animation_progress :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    IO CDouble

{-# DEPRECATED layoutManagerGetAnimationProgress ["(Since version 1.12)"] #-}
-- | Retrieves the progress of the animation, if one has been started by
-- 'GI.Clutter.Objects.LayoutManager.layoutManagerBeginAnimation'
-- 
-- The returned value has the same semantics of the t'GI.Clutter.Objects.Alpha.Alpha':@/alpha/@
-- value
-- 
-- /Since: 1.2/
layoutManagerGetAnimationProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> m Double
    -- ^ __Returns:__ the progress of the animation
layoutManagerGetAnimationProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutManager a) =>
a -> m Double
layoutManagerGetAnimationProgress a
manager = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    CDouble
result <- Ptr LayoutManager -> IO CDouble
clutter_layout_manager_get_animation_progress Ptr LayoutManager
manager'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetAnimationProgressMethodInfo
instance (signature ~ (m Double), MonadIO m, IsLayoutManager a) => O.OverloadedMethod LayoutManagerGetAnimationProgressMethodInfo a signature where
    overloadedMethod = layoutManagerGetAnimationProgress

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


#endif

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

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

-- | Retrieves the t'GI.Clutter.Objects.LayoutMeta.LayoutMeta' that the layout /@manager@/ associated
-- to the /@actor@/ child of /@container@/, eventually by creating one if the
-- t'GI.Clutter.Objects.LayoutManager.LayoutManager' supports layout properties
-- 
-- /Since: 1.0/
layoutManagerGetChildMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b, Clutter.Actor.IsActor c) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> c
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor' child of /@container@/
    -> m Clutter.LayoutMeta.LayoutMeta
    -- ^ __Returns:__ a t'GI.Clutter.Objects.LayoutMeta.LayoutMeta', or 'P.Nothing' if the
    --   t'GI.Clutter.Objects.LayoutManager.LayoutManager' does not have layout properties. The returned
    --   layout meta instance is owned by the t'GI.Clutter.Objects.LayoutManager.LayoutManager' and it
    --   should not be unreferenced
layoutManagerGetChildMeta :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b,
 IsActor c) =>
a -> b -> c -> m LayoutMeta
layoutManagerGetChildMeta a
manager b
container c
actor = IO LayoutMeta -> m LayoutMeta
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LayoutMeta -> m LayoutMeta) -> IO LayoutMeta -> m LayoutMeta
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
container' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
container
    Ptr Actor
actor' <- c -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
actor
    Ptr LayoutMeta
result <- Ptr LayoutManager
-> Ptr Container -> Ptr Actor -> IO (Ptr LayoutMeta)
clutter_layout_manager_get_child_meta Ptr LayoutManager
manager' Ptr Container
container' Ptr Actor
actor'
    Text -> Ptr LayoutMeta -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutManagerGetChildMeta" Ptr LayoutMeta
result
    LayoutMeta
result' <- ((ManagedPtr LayoutMeta -> LayoutMeta)
-> Ptr LayoutMeta -> IO LayoutMeta
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr LayoutMeta -> LayoutMeta
Clutter.LayoutMeta.LayoutMeta) Ptr LayoutMeta
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
container
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
actor
    LayoutMeta -> IO LayoutMeta
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutMeta
result'

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetChildMetaMethodInfo
instance (signature ~ (b -> c -> m Clutter.LayoutMeta.LayoutMeta), MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b, Clutter.Actor.IsActor c) => O.OverloadedMethod LayoutManagerGetChildMetaMethodInfo a signature where
    overloadedMethod = layoutManagerGetChildMeta

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


#endif

-- method LayoutManager::get_preferred_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterContainer using @manager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "for_width"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the width for which the height should be computed, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_height_p"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the minimum height\n  of the layout, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nat_height_p"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the natural height\n  of the layout, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_layout_manager_get_preferred_height" clutter_layout_manager_get_preferred_height :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    Ptr Clutter.Container.Container ->      -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    CFloat ->                               -- for_width : TBasicType TFloat
    Ptr CFloat ->                           -- min_height_p : TBasicType TFloat
    Ptr CFloat ->                           -- nat_height_p : TBasicType TFloat
    IO ()

-- | Computes the minimum and natural heights of the /@container@/ according
-- to /@manager@/.
-- 
-- See also 'GI.Clutter.Objects.Actor.actorGetPreferredHeight'
-- 
-- /Since: 1.2/
layoutManagerGetPreferredHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@container@/: the t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> Float
    -- ^ /@forWidth@/: the width for which the height should be computed, or -1
    -> m ((Float, Float))
layoutManagerGetPreferredHeight :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b) =>
a -> b -> Float -> m (Float, Float)
layoutManagerGetPreferredHeight a
manager b
container Float
forWidth = IO (Float, Float) -> m (Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
container' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
container
    let forWidth' :: CFloat
forWidth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
forWidth
    Ptr CFloat
minHeightP <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
natHeightP <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr LayoutManager
-> Ptr Container -> CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_layout_manager_get_preferred_height Ptr LayoutManager
manager' Ptr Container
container' CFloat
forWidth' Ptr CFloat
minHeightP Ptr CFloat
natHeightP
    CFloat
minHeightP' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
minHeightP
    let minHeightP'' :: Float
minHeightP'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
minHeightP'
    CFloat
natHeightP' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
natHeightP
    let natHeightP'' :: Float
natHeightP'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
natHeightP'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
container
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
minHeightP
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
natHeightP
    (Float, Float) -> IO (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
minHeightP'', Float
natHeightP'')

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetPreferredHeightMethodInfo
instance (signature ~ (b -> Float -> m ((Float, Float))), MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) => O.OverloadedMethod LayoutManagerGetPreferredHeightMethodInfo a signature where
    overloadedMethod = layoutManagerGetPreferredHeight

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


#endif

-- method LayoutManager::get_preferred_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "LayoutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterLayoutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterContainer using @manager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "for_height"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the height for which the width should be computed, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_width_p"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the minimum width\n  of the layout, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "nat_width_p"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the natural width\n  of the layout, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_layout_manager_get_preferred_width" clutter_layout_manager_get_preferred_width :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    Ptr Clutter.Container.Container ->      -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    CFloat ->                               -- for_height : TBasicType TFloat
    Ptr CFloat ->                           -- min_width_p : TBasicType TFloat
    Ptr CFloat ->                           -- nat_width_p : TBasicType TFloat
    IO ()

-- | Computes the minimum and natural widths of the /@container@/ according
-- to /@manager@/.
-- 
-- See also 'GI.Clutter.Objects.Actor.actorGetPreferredWidth'
-- 
-- /Since: 1.2/
layoutManagerGetPreferredWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> b
    -- ^ /@container@/: the t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> Float
    -- ^ /@forHeight@/: the height for which the width should be computed, or -1
    -> m ((Float, Float))
layoutManagerGetPreferredWidth :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b) =>
a -> b -> Float -> m (Float, Float)
layoutManagerGetPreferredWidth a
manager b
container Float
forHeight = IO (Float, Float) -> m (Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
container' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
container
    let forHeight' :: CFloat
forHeight' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
forHeight
    Ptr CFloat
minWidthP <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
natWidthP <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr LayoutManager
-> Ptr Container -> CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_layout_manager_get_preferred_width Ptr LayoutManager
manager' Ptr Container
container' CFloat
forHeight' Ptr CFloat
minWidthP Ptr CFloat
natWidthP
    CFloat
minWidthP' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
minWidthP
    let minWidthP'' :: Float
minWidthP'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
minWidthP'
    CFloat
natWidthP' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
natWidthP
    let natWidthP'' :: Float
natWidthP'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
natWidthP'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
container
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
minWidthP
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
natWidthP
    (Float, Float) -> IO (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
minWidthP'', Float
natWidthP'')

#if defined(ENABLE_OVERLOADING)
data LayoutManagerGetPreferredWidthMethodInfo
instance (signature ~ (b -> Float -> m ((Float, Float))), MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) => O.OverloadedMethod LayoutManagerGetPreferredWidthMethodInfo a signature where
    overloadedMethod = layoutManagerGetPreferredWidth

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


#endif

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

foreign import ccall "clutter_layout_manager_layout_changed" clutter_layout_manager_layout_changed :: 
    Ptr LayoutManager ->                    -- manager : TInterface (Name {namespace = "Clutter", name = "LayoutManager"})
    IO ()

-- | Emits the [layoutChanged]("GI.Clutter.Objects.LayoutManager#g:signal:layoutChanged") signal on /@manager@/
-- 
-- This function should only be called by implementations of the
-- t'GI.Clutter.Objects.LayoutManager.LayoutManager' class
-- 
-- /Since: 1.2/
layoutManagerLayoutChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> m ()
layoutManagerLayoutChanged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutManager a) =>
a -> m ()
layoutManagerLayoutChanged a
manager = 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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr LayoutManager -> IO ()
clutter_layout_manager_layout_changed Ptr LayoutManager
manager'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayoutManagerLayoutChangedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsLayoutManager a) => O.OverloadedMethod LayoutManagerLayoutChangedMethodInfo a signature where
    overloadedMethod = layoutManagerLayoutChanged

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


#endif

-- XXX Could not generate method LayoutManager::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 LayoutManagerListChildPropertiesMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listChildProperties" LayoutManager) => O.OverloadedMethod LayoutManagerListChildPropertiesMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "listChildProperties" LayoutManager) => O.OverloadedMethodInfo LayoutManagerListChildPropertiesMethodInfo o where
    overloadedMethodInfo = undefined

#endif

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

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

-- | If the t'GI.Clutter.Objects.LayoutManager.LayoutManager' sub-class allows it, allow
-- adding a weak reference of the /@container@/ using /@manager@/
-- from within the layout manager
-- 
-- The layout manager should not increase the reference
-- count of the /@container@/
-- 
-- /Since: 1.2/
layoutManagerSetContainer ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) =>
    a
    -- ^ /@manager@/: a t'GI.Clutter.Objects.LayoutManager.LayoutManager'
    -> Maybe (b)
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container' using /@manager@/
    -> m ()
layoutManagerSetContainer :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayoutManager a, IsContainer b) =>
a -> Maybe b -> m ()
layoutManagerSetContainer a
manager Maybe b
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 LayoutManager
manager' <- a -> IO (Ptr LayoutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr Container
maybeContainer <- case Maybe b
container of
        Maybe b
Nothing -> Ptr Container -> IO (Ptr Container)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Container
forall a. Ptr a
nullPtr
        Just b
jContainer -> do
            Ptr Container
jContainer' <- b -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jContainer
            Ptr Container -> IO (Ptr Container)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Container
jContainer'
    Ptr LayoutManager -> Ptr Container -> IO ()
clutter_layout_manager_set_container Ptr LayoutManager
manager' Ptr Container
maybeContainer
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
container b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayoutManagerSetContainerMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsLayoutManager a, Clutter.Container.IsContainer b) => O.OverloadedMethod LayoutManagerSetContainerMethodInfo a signature where
    overloadedMethod = layoutManagerSetContainer

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


#endif