{-# LANGUAGE 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.BinLayout.BinLayout' 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.BinLayout
    ( 

-- * Exported types
    BinLayout(..)                           ,
    IsBinLayout                             ,
    toBinLayout                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [add]("GI.Clutter.Objects.BinLayout#g:method:add"), [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
-- [getAlignment]("GI.Clutter.Objects.BinLayout#g:method:getAlignment"), [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
-- [setAlignment]("GI.Clutter.Objects.BinLayout#g:method:setAlignment"), [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)
    ResolveBinLayoutMethod                  ,
#endif

-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    BinLayoutAddMethodInfo                  ,
#endif
    binLayoutAdd                            ,


-- ** getAlignment #method:getAlignment#

#if defined(ENABLE_OVERLOADING)
    BinLayoutGetAlignmentMethodInfo         ,
#endif
    binLayoutGetAlignment                   ,


-- ** new #method:new#

    binLayoutNew                            ,


-- ** setAlignment #method:setAlignment#

#if defined(ENABLE_OVERLOADING)
    BinLayoutSetAlignmentMethodInfo         ,
#endif
    binLayoutSetAlignment                   ,




 -- * Properties


-- ** xAlign #attr:xAlign#
-- | The default horizontal alignment policy for actors managed
-- by the t'GI.Clutter.Objects.BinLayout.BinLayout'
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    BinLayoutXAlignPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    binLayoutXAlign                         ,
#endif
    constructBinLayoutXAlign                ,
    getBinLayoutXAlign                      ,
    setBinLayoutXAlign                      ,


-- ** yAlign #attr:yAlign#
-- | The default vertical alignment policy for actors managed
-- by the t'GI.Clutter.Objects.BinLayout.BinLayout'
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    BinLayoutYAlignPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    binLayoutYAlign                         ,
#endif
    constructBinLayoutYAlign                ,
    getBinLayoutYAlign                      ,
    setBinLayoutYAlign                      ,




    ) 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.GHashTable as B.GHT
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.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutManager as Clutter.LayoutManager
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_bin_layout_get_type"
    c_clutter_bin_layout_get_type :: IO B.Types.GType

instance B.Types.TypedObject BinLayout where
    glibType :: IO GType
glibType = IO GType
c_clutter_bin_layout_get_type

instance B.Types.GObject BinLayout

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "x-align"
   -- Type: TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@x-align@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' binLayout #xAlign
-- @
getBinLayoutXAlign :: (MonadIO m, IsBinLayout o) => o -> m Clutter.Enums.BinAlignment
getBinLayoutXAlign :: forall (m :: * -> *) o.
(MonadIO m, IsBinLayout o) =>
o -> m BinAlignment
getBinLayoutXAlign o
obj = IO BinAlignment -> m BinAlignment
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO BinAlignment -> m BinAlignment)
-> IO BinAlignment -> m BinAlignment
forall a b. (a -> b) -> a -> b
$ o -> String -> IO BinAlignment
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"x-align"

-- | Set the value of the “@x-align@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' binLayout [ #xAlign 'Data.GI.Base.Attributes.:=' value ]
-- @
setBinLayoutXAlign :: (MonadIO m, IsBinLayout o) => o -> Clutter.Enums.BinAlignment -> m ()
setBinLayoutXAlign :: forall (m :: * -> *) o.
(MonadIO m, IsBinLayout o) =>
o -> BinAlignment -> m ()
setBinLayoutXAlign o
obj BinAlignment
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> BinAlignment -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"x-align" BinAlignment
val

-- | Construct a `GValueConstruct` with valid value for the “@x-align@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBinLayoutXAlign :: (IsBinLayout o, MIO.MonadIO m) => Clutter.Enums.BinAlignment -> m (GValueConstruct o)
constructBinLayoutXAlign :: forall o (m :: * -> *).
(IsBinLayout o, MonadIO m) =>
BinAlignment -> m (GValueConstruct o)
constructBinLayoutXAlign BinAlignment
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> BinAlignment -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"x-align" BinAlignment
val

#if defined(ENABLE_OVERLOADING)
data BinLayoutXAlignPropertyInfo
instance AttrInfo BinLayoutXAlignPropertyInfo where
    type AttrAllowedOps BinLayoutXAlignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BinLayoutXAlignPropertyInfo = IsBinLayout
    type AttrSetTypeConstraint BinLayoutXAlignPropertyInfo = (~) Clutter.Enums.BinAlignment
    type AttrTransferTypeConstraint BinLayoutXAlignPropertyInfo = (~) Clutter.Enums.BinAlignment
    type AttrTransferType BinLayoutXAlignPropertyInfo = Clutter.Enums.BinAlignment
    type AttrGetType BinLayoutXAlignPropertyInfo = Clutter.Enums.BinAlignment
    type AttrLabel BinLayoutXAlignPropertyInfo = "x-align"
    type AttrOrigin BinLayoutXAlignPropertyInfo = BinLayout
    attrGet = getBinLayoutXAlign
    attrSet = setBinLayoutXAlign
    attrTransfer _ v = do
        return v
    attrConstruct = constructBinLayoutXAlign
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BinLayout.xAlign"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BinLayout.html#g:attr:xAlign"
        })
#endif

-- VVV Prop "y-align"
   -- Type: TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@y-align@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' binLayout #yAlign
-- @
getBinLayoutYAlign :: (MonadIO m, IsBinLayout o) => o -> m Clutter.Enums.BinAlignment
getBinLayoutYAlign :: forall (m :: * -> *) o.
(MonadIO m, IsBinLayout o) =>
o -> m BinAlignment
getBinLayoutYAlign o
obj = IO BinAlignment -> m BinAlignment
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO BinAlignment -> m BinAlignment)
-> IO BinAlignment -> m BinAlignment
forall a b. (a -> b) -> a -> b
$ o -> String -> IO BinAlignment
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"y-align"

-- | Set the value of the “@y-align@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' binLayout [ #yAlign 'Data.GI.Base.Attributes.:=' value ]
-- @
setBinLayoutYAlign :: (MonadIO m, IsBinLayout o) => o -> Clutter.Enums.BinAlignment -> m ()
setBinLayoutYAlign :: forall (m :: * -> *) o.
(MonadIO m, IsBinLayout o) =>
o -> BinAlignment -> m ()
setBinLayoutYAlign o
obj BinAlignment
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> BinAlignment -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"y-align" BinAlignment
val

-- | Construct a `GValueConstruct` with valid value for the “@y-align@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBinLayoutYAlign :: (IsBinLayout o, MIO.MonadIO m) => Clutter.Enums.BinAlignment -> m (GValueConstruct o)
constructBinLayoutYAlign :: forall o (m :: * -> *).
(IsBinLayout o, MonadIO m) =>
BinAlignment -> m (GValueConstruct o)
constructBinLayoutYAlign BinAlignment
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> BinAlignment -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"y-align" BinAlignment
val

#if defined(ENABLE_OVERLOADING)
data BinLayoutYAlignPropertyInfo
instance AttrInfo BinLayoutYAlignPropertyInfo where
    type AttrAllowedOps BinLayoutYAlignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BinLayoutYAlignPropertyInfo = IsBinLayout
    type AttrSetTypeConstraint BinLayoutYAlignPropertyInfo = (~) Clutter.Enums.BinAlignment
    type AttrTransferTypeConstraint BinLayoutYAlignPropertyInfo = (~) Clutter.Enums.BinAlignment
    type AttrTransferType BinLayoutYAlignPropertyInfo = Clutter.Enums.BinAlignment
    type AttrGetType BinLayoutYAlignPropertyInfo = Clutter.Enums.BinAlignment
    type AttrLabel BinLayoutYAlignPropertyInfo = "y-align"
    type AttrOrigin BinLayoutYAlignPropertyInfo = BinLayout
    attrGet = getBinLayoutYAlign
    attrSet = setBinLayoutYAlign
    attrTransfer _ v = do
        return v
    attrConstruct = constructBinLayoutYAlign
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BinLayout.yAlign"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BinLayout.html#g:attr:yAlign"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BinLayout
type instance O.AttributeList BinLayout = BinLayoutAttributeList
type BinLayoutAttributeList = ('[ '("xAlign", BinLayoutXAlignPropertyInfo), '("yAlign", BinLayoutYAlignPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
binLayoutXAlign :: AttrLabelProxy "xAlign"
binLayoutXAlign = AttrLabelProxy

binLayoutYAlign :: AttrLabelProxy "yAlign"
binLayoutYAlign = AttrLabelProxy

#endif

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

#endif

-- method BinLayout::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "x_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the default alignment policy to be used on the\n  horizontal axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the default alignment policy to be used on the\n  vertical axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "BinLayout" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bin_layout_new" clutter_bin_layout_new :: 
    CUInt ->                                -- x_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    CUInt ->                                -- y_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    IO (Ptr BinLayout)

-- | Creates a new t'GI.Clutter.Objects.BinLayout.BinLayout' layout manager
-- 
-- /Since: 1.2/
binLayoutNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Clutter.Enums.BinAlignment
    -- ^ /@xAlign@/: the default alignment policy to be used on the
    --   horizontal axis
    -> Clutter.Enums.BinAlignment
    -- ^ /@yAlign@/: the default alignment policy to be used on the
    --   vertical axis
    -> m BinLayout
    -- ^ __Returns:__ the newly created layout manager
binLayoutNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BinAlignment -> BinAlignment -> m BinLayout
binLayoutNew BinAlignment
xAlign BinAlignment
yAlign = IO BinLayout -> m BinLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BinLayout -> m BinLayout) -> IO BinLayout -> m BinLayout
forall a b. (a -> b) -> a -> b
$ do
    let xAlign' :: CUInt
xAlign' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BinAlignment -> Int) -> BinAlignment -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinAlignment -> Int
forall a. Enum a => a -> Int
fromEnum) BinAlignment
xAlign
    let yAlign' :: CUInt
yAlign' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BinAlignment -> Int) -> BinAlignment -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinAlignment -> Int
forall a. Enum a => a -> Int
fromEnum) BinAlignment
yAlign
    Ptr BinLayout
result <- CUInt -> CUInt -> IO (Ptr BinLayout)
clutter_bin_layout_new CUInt
xAlign' CUInt
yAlign'
    Text -> Ptr BinLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"binLayoutNew" Ptr BinLayout
result
    BinLayout
result' <- ((ManagedPtr BinLayout -> BinLayout)
-> Ptr BinLayout -> IO BinLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr BinLayout -> BinLayout
BinLayout) Ptr BinLayout
result
    BinLayout -> IO BinLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BinLayout
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BinLayout::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBinLayout"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "horizontal alignment policy for @child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical alignment policy for @child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bin_layout_add" clutter_bin_layout_add :: 
    Ptr BinLayout ->                        -- self : TInterface (Name {namespace = "Clutter", name = "BinLayout"})
    Ptr Clutter.Actor.Actor ->              -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CUInt ->                                -- x_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    CUInt ->                                -- y_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    IO ()

{-# DEPRECATED binLayoutAdd ["(Since version 1.12)","Use 'GI.Clutter.Objects.Actor.actorAddChild' instead."] #-}
-- | Adds a t'GI.Clutter.Objects.Actor.Actor' to the container using /@self@/ and
-- sets the alignment policies for it
-- 
-- This function is equivalent to 'GI.Clutter.Interfaces.Container.containerAddActor'
-- and 'GI.Clutter.Objects.LayoutManager.layoutManagerChildSetProperty' but it does not
-- require a pointer to the t'GI.Clutter.Interfaces.Container.Container' associated to the
-- t'GI.Clutter.Objects.BinLayout.BinLayout'
-- 
-- /Since: 1.2/
binLayoutAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsBinLayout a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@self@/: a t'GI.Clutter.Objects.BinLayout.BinLayout'
    -> b
    -- ^ /@child@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> Clutter.Enums.BinAlignment
    -- ^ /@xAlign@/: horizontal alignment policy for /@child@/
    -> Clutter.Enums.BinAlignment
    -- ^ /@yAlign@/: vertical alignment policy for /@child@/
    -> m ()
binLayoutAdd :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBinLayout a, IsActor b) =>
a -> b -> BinAlignment -> BinAlignment -> m ()
binLayoutAdd a
self b
child BinAlignment
xAlign BinAlignment
yAlign = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BinLayout
self' <- a -> IO (Ptr BinLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Actor
child' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    let xAlign' :: CUInt
xAlign' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BinAlignment -> Int) -> BinAlignment -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinAlignment -> Int
forall a. Enum a => a -> Int
fromEnum) BinAlignment
xAlign
    let yAlign' :: CUInt
yAlign' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BinAlignment -> Int) -> BinAlignment -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinAlignment -> Int
forall a. Enum a => a -> Int
fromEnum) BinAlignment
yAlign
    Ptr BinLayout -> Ptr Actor -> CUInt -> CUInt -> IO ()
clutter_bin_layout_add Ptr BinLayout
self' Ptr Actor
child' CUInt
xAlign' CUInt
yAlign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BinLayoutAddMethodInfo
instance (signature ~ (b -> Clutter.Enums.BinAlignment -> Clutter.Enums.BinAlignment -> m ()), MonadIO m, IsBinLayout a, Clutter.Actor.IsActor b) => O.OverloadedMethod BinLayoutAddMethodInfo a signature where
    overloadedMethod = binLayoutAdd

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


#endif

-- method BinLayout::get_alignment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBinLayout"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a child of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the horizontal\n  alignment policy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the vertical\n  alignment policy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bin_layout_get_alignment" clutter_bin_layout_get_alignment :: 
    Ptr BinLayout ->                        -- self : TInterface (Name {namespace = "Clutter", name = "BinLayout"})
    Ptr Clutter.Actor.Actor ->              -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr CUInt ->                            -- x_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    Ptr CUInt ->                            -- y_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    IO ()

{-# DEPRECATED binLayoutGetAlignment ["(Since version 1.12)","Use the [Actor:xAlign](\"GI.Clutter.Objects.Actor#g:attr:xAlign\") and the","  [Actor:yAlign](\"GI.Clutter.Objects.Actor#g:attr:yAlign\") properties of t'GI.Clutter.Objects.Actor.Actor' instead."] #-}
-- | Retrieves the horizontal and vertical alignment policies for
-- a child of /@self@/
-- 
-- If /@child@/ is 'P.Nothing' the default alignment policies will be returned
-- instead
-- 
-- /Since: 1.2/
binLayoutGetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsBinLayout a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@self@/: a t'GI.Clutter.Objects.BinLayout.BinLayout'
    -> Maybe (b)
    -- ^ /@child@/: a child of /@container@/
    -> m ((Clutter.Enums.BinAlignment, Clutter.Enums.BinAlignment))
binLayoutGetAlignment :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBinLayout a, IsActor b) =>
a -> Maybe b -> m (BinAlignment, BinAlignment)
binLayoutGetAlignment a
self Maybe b
child = IO (BinAlignment, BinAlignment) -> m (BinAlignment, BinAlignment)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (BinAlignment, BinAlignment) -> m (BinAlignment, BinAlignment))
-> IO (BinAlignment, BinAlignment)
-> m (BinAlignment, BinAlignment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BinLayout
self' <- a -> IO (Ptr BinLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Actor
maybeChild <- case Maybe b
child of
        Maybe b
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just b
jChild -> do
            Ptr Actor
jChild' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
            Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jChild'
    Ptr CUInt
xAlign <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
yAlign <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr BinLayout -> Ptr Actor -> Ptr CUInt -> Ptr CUInt -> IO ()
clutter_bin_layout_get_alignment Ptr BinLayout
self' Ptr Actor
maybeChild Ptr CUInt
xAlign Ptr CUInt
yAlign
    CUInt
xAlign' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
xAlign
    let xAlign'' :: BinAlignment
xAlign'' = (Int -> BinAlignment
forall a. Enum a => Int -> a
toEnum (Int -> BinAlignment) -> (CUInt -> Int) -> CUInt -> BinAlignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
xAlign'
    CUInt
yAlign' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
yAlign
    let yAlign'' :: BinAlignment
yAlign'' = (Int -> BinAlignment
forall a. Enum a => Int -> a
toEnum (Int -> BinAlignment) -> (CUInt -> Int) -> CUInt -> BinAlignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
yAlign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
child b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
xAlign
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
yAlign
    (BinAlignment, BinAlignment) -> IO (BinAlignment, BinAlignment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BinAlignment
xAlign'', BinAlignment
yAlign'')

#if defined(ENABLE_OVERLOADING)
data BinLayoutGetAlignmentMethodInfo
instance (signature ~ (Maybe (b) -> m ((Clutter.Enums.BinAlignment, Clutter.Enums.BinAlignment))), MonadIO m, IsBinLayout a, Clutter.Actor.IsActor b) => O.OverloadedMethod BinLayoutGetAlignmentMethodInfo a signature where
    overloadedMethod = binLayoutGetAlignment

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


#endif

-- method BinLayout::set_alignment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBinLayout"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a child of @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the horizontal alignment policy to be used for the @child\n  inside @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_align"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BinAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the vertical aligment policy to be used on the @child\n  inside @container"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bin_layout_set_alignment" clutter_bin_layout_set_alignment :: 
    Ptr BinLayout ->                        -- self : TInterface (Name {namespace = "Clutter", name = "BinLayout"})
    Ptr Clutter.Actor.Actor ->              -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CUInt ->                                -- x_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    CUInt ->                                -- y_align : TInterface (Name {namespace = "Clutter", name = "BinAlignment"})
    IO ()

{-# DEPRECATED binLayoutSetAlignment ["(Since version 1.12)","Use the [Actor:xAlign](\"GI.Clutter.Objects.Actor#g:attr:xAlign\") and","  [Actor:yAlign](\"GI.Clutter.Objects.Actor#g:attr:yAlign\") properties of t'GI.Clutter.Objects.Actor.Actor' instead."] #-}
-- | Sets the horizontal and vertical alignment policies to be applied
-- to a /@child@/ of /@self@/
-- 
-- If /@child@/ is 'P.Nothing' then the /@xAlign@/ and /@yAlign@/ values will
-- be set as the default alignment policies
-- 
-- /Since: 1.2/
binLayoutSetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m, IsBinLayout a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@self@/: a t'GI.Clutter.Objects.BinLayout.BinLayout'
    -> Maybe (b)
    -- ^ /@child@/: a child of /@container@/
    -> Clutter.Enums.BinAlignment
    -- ^ /@xAlign@/: the horizontal alignment policy to be used for the /@child@/
    --   inside /@container@/
    -> Clutter.Enums.BinAlignment
    -- ^ /@yAlign@/: the vertical aligment policy to be used on the /@child@/
    --   inside /@container@/
    -> m ()
binLayoutSetAlignment :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBinLayout a, IsActor b) =>
a -> Maybe b -> BinAlignment -> BinAlignment -> m ()
binLayoutSetAlignment a
self Maybe b
child BinAlignment
xAlign BinAlignment
yAlign = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BinLayout
self' <- a -> IO (Ptr BinLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Actor
maybeChild <- case Maybe b
child of
        Maybe b
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just b
jChild -> do
            Ptr Actor
jChild' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
            Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jChild'
    let xAlign' :: CUInt
xAlign' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BinAlignment -> Int) -> BinAlignment -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinAlignment -> Int
forall a. Enum a => a -> Int
fromEnum) BinAlignment
xAlign
    let yAlign' :: CUInt
yAlign' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BinAlignment -> Int) -> BinAlignment -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinAlignment -> Int
forall a. Enum a => a -> Int
fromEnum) BinAlignment
yAlign
    Ptr BinLayout -> Ptr Actor -> CUInt -> CUInt -> IO ()
clutter_bin_layout_set_alignment Ptr BinLayout
self' Ptr Actor
maybeChild CUInt
xAlign' CUInt
yAlign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
child b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BinLayoutSetAlignmentMethodInfo
instance (signature ~ (Maybe (b) -> Clutter.Enums.BinAlignment -> Clutter.Enums.BinAlignment -> m ()), MonadIO m, IsBinLayout a, Clutter.Actor.IsActor b) => O.OverloadedMethod BinLayoutSetAlignmentMethodInfo a signature where
    overloadedMethod = binLayoutSetAlignment

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


#endif