{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Clutter.Objects.FlowLayout
    ( 
    FlowLayout(..)                          ,
    IsFlowLayout                            ,
    toFlowLayout                            ,
 
#if defined(ENABLE_OVERLOADING)
    ResolveFlowLayoutMethod                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetColumnSpacingMethodInfo    ,
#endif
    flowLayoutGetColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetColumnWidthMethodInfo      ,
#endif
    flowLayoutGetColumnWidth                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetHomogeneousMethodInfo      ,
#endif
    flowLayoutGetHomogeneous                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetOrientationMethodInfo      ,
#endif
    flowLayoutGetOrientation                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetRowHeightMethodInfo        ,
#endif
    flowLayoutGetRowHeight                  ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetRowSpacingMethodInfo       ,
#endif
    flowLayoutGetRowSpacing                 ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutGetSnapToGridMethodInfo       ,
#endif
    flowLayoutGetSnapToGrid                 ,
    flowLayoutNew                           ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetColumnSpacingMethodInfo    ,
#endif
    flowLayoutSetColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetColumnWidthMethodInfo      ,
#endif
    flowLayoutSetColumnWidth                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetHomogeneousMethodInfo      ,
#endif
    flowLayoutSetHomogeneous                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetOrientationMethodInfo      ,
#endif
    flowLayoutSetOrientation                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetRowHeightMethodInfo        ,
#endif
    flowLayoutSetRowHeight                  ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetRowSpacingMethodInfo       ,
#endif
    flowLayoutSetRowSpacing                 ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSetSnapToGridMethodInfo       ,
#endif
    flowLayoutSetSnapToGrid                 ,
 
#if defined(ENABLE_OVERLOADING)
    FlowLayoutColumnSpacingPropertyInfo     ,
#endif
    constructFlowLayoutColumnSpacing        ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutColumnSpacing                 ,
#endif
    getFlowLayoutColumnSpacing              ,
    setFlowLayoutColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutHomogeneousPropertyInfo       ,
#endif
    constructFlowLayoutHomogeneous          ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutHomogeneous                   ,
#endif
    getFlowLayoutHomogeneous                ,
    setFlowLayoutHomogeneous                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutMaxColumnWidthPropertyInfo    ,
#endif
    constructFlowLayoutMaxColumnWidth       ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutMaxColumnWidth                ,
#endif
    getFlowLayoutMaxColumnWidth             ,
    setFlowLayoutMaxColumnWidth             ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutMaxRowHeightPropertyInfo      ,
#endif
    constructFlowLayoutMaxRowHeight         ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutMaxRowHeight                  ,
#endif
    getFlowLayoutMaxRowHeight               ,
    setFlowLayoutMaxRowHeight               ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutMinColumnWidthPropertyInfo    ,
#endif
    constructFlowLayoutMinColumnWidth       ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutMinColumnWidth                ,
#endif
    getFlowLayoutMinColumnWidth             ,
    setFlowLayoutMinColumnWidth             ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutMinRowHeightPropertyInfo      ,
#endif
    constructFlowLayoutMinRowHeight         ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutMinRowHeight                  ,
#endif
    getFlowLayoutMinRowHeight               ,
    setFlowLayoutMinRowHeight               ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutOrientationPropertyInfo       ,
#endif
    constructFlowLayoutOrientation          ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutOrientation                   ,
#endif
    getFlowLayoutOrientation                ,
    setFlowLayoutOrientation                ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutRowSpacingPropertyInfo        ,
#endif
    constructFlowLayoutRowSpacing           ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutRowSpacing                    ,
#endif
    getFlowLayoutRowSpacing                 ,
    setFlowLayoutRowSpacing                 ,
#if defined(ENABLE_OVERLOADING)
    FlowLayoutSnapToGridPropertyInfo        ,
#endif
    constructFlowLayoutSnapToGrid           ,
#if defined(ENABLE_OVERLOADING)
    flowLayoutSnapToGrid                    ,
#endif
    getFlowLayoutSnapToGrid                 ,
    setFlowLayoutSnapToGrid                 ,
    ) 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.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.Cairo.Structs.RectangleInt as Cairo.RectangleInt
import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Animatable as Clutter.Animatable
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Container as Clutter.Container
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Content as Clutter.Content
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Action as Clutter.Action
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Animation as Clutter.Animation
import {-# SOURCE #-} qualified GI.Clutter.Objects.Animator as Clutter.Animator
import {-# SOURCE #-} qualified GI.Clutter.Objects.Backend as Clutter.Backend
import {-# SOURCE #-} qualified GI.Clutter.Objects.ChildMeta as Clutter.ChildMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Constraint as Clutter.Constraint
import {-# SOURCE #-} qualified GI.Clutter.Objects.DeviceManager as Clutter.DeviceManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.Effect as Clutter.Effect
import {-# SOURCE #-} qualified GI.Clutter.Objects.Group as Clutter.Group
import {-# SOURCE #-} qualified GI.Clutter.Objects.InputDevice as Clutter.InputDevice
import {-# SOURCE #-} qualified GI.Clutter.Objects.Interval as Clutter.Interval
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutManager as Clutter.LayoutManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutMeta as Clutter.LayoutMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Script as Clutter.Script
import {-# SOURCE #-} qualified GI.Clutter.Objects.Shader as Clutter.Shader
import {-# SOURCE #-} qualified GI.Clutter.Objects.Stage as Clutter.Stage
import {-# SOURCE #-} qualified GI.Clutter.Objects.State as Clutter.State
import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import {-# SOURCE #-} qualified GI.Clutter.Objects.Transition as Clutter.Transition
import {-# SOURCE #-} qualified GI.Clutter.Structs.ActorBox as Clutter.ActorBox
import {-# SOURCE #-} qualified GI.Clutter.Structs.AnimatorKey as Clutter.AnimatorKey
import {-# SOURCE #-} qualified GI.Clutter.Structs.ButtonEvent as Clutter.ButtonEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Color as Clutter.Color
import {-# SOURCE #-} qualified GI.Clutter.Structs.CrossingEvent as Clutter.CrossingEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.EventSequence as Clutter.EventSequence
import {-# SOURCE #-} qualified GI.Clutter.Structs.Fog as Clutter.Fog
import {-# SOURCE #-} qualified GI.Clutter.Structs.Geometry as Clutter.Geometry
import {-# SOURCE #-} qualified GI.Clutter.Structs.KeyEvent as Clutter.KeyEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Margin as Clutter.Margin
import {-# SOURCE #-} qualified GI.Clutter.Structs.Matrix as Clutter.Matrix
import {-# SOURCE #-} qualified GI.Clutter.Structs.MotionEvent as Clutter.MotionEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.PaintVolume as Clutter.PaintVolume
import {-# SOURCE #-} qualified GI.Clutter.Structs.Perspective as Clutter.Perspective
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import {-# SOURCE #-} qualified GI.Clutter.Structs.Rect as Clutter.Rect
import {-# SOURCE #-} qualified GI.Clutter.Structs.ScrollEvent as Clutter.ScrollEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Size as Clutter.Size
import {-# SOURCE #-} qualified GI.Clutter.Structs.StateKey as Clutter.StateKey
import {-# SOURCE #-} qualified GI.Clutter.Structs.Vertex as Clutter.Vertex
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Json.Structs.Node as Json.Node
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.Layout as Pango.Layout
#else
import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutManager as Clutter.LayoutManager
import qualified GI.GObject.Objects.Object as GObject.Object
#endif
newtype FlowLayout = FlowLayout (SP.ManagedPtr FlowLayout)
    deriving (FlowLayout -> FlowLayout -> Bool
(FlowLayout -> FlowLayout -> Bool)
-> (FlowLayout -> FlowLayout -> Bool) -> Eq FlowLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlowLayout -> FlowLayout -> Bool
== :: FlowLayout -> FlowLayout -> Bool
$c/= :: FlowLayout -> FlowLayout -> Bool
/= :: FlowLayout -> FlowLayout -> Bool
Eq)
instance SP.ManagedPtrNewtype FlowLayout where
    toManagedPtr :: FlowLayout -> ManagedPtr FlowLayout
toManagedPtr (FlowLayout ManagedPtr FlowLayout
p) = ManagedPtr FlowLayout
p
foreign import ccall "clutter_flow_layout_get_type"
    c_clutter_flow_layout_get_type :: IO B.Types.GType
instance B.Types.TypedObject FlowLayout where
    glibType :: IO GType
glibType = IO GType
c_clutter_flow_layout_get_type
instance B.Types.GObject FlowLayout
class (SP.GObject o, O.IsDescendantOf FlowLayout o) => IsFlowLayout o
instance (SP.GObject o, O.IsDescendantOf FlowLayout o) => IsFlowLayout o
instance O.HasParentTypes FlowLayout
type instance O.ParentTypes FlowLayout = '[Clutter.LayoutManager.LayoutManager, GObject.Object.Object]
toFlowLayout :: (MIO.MonadIO m, IsFlowLayout o) => o -> m FlowLayout
toFlowLayout :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> m FlowLayout
toFlowLayout = IO FlowLayout -> m FlowLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO FlowLayout -> m FlowLayout)
-> (o -> IO FlowLayout) -> o -> m FlowLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr FlowLayout -> FlowLayout) -> o -> IO FlowLayout
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr FlowLayout -> FlowLayout
FlowLayout
instance B.GValue.IsGValue (Maybe FlowLayout) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_flow_layout_get_type
    gvalueSet_ :: Ptr GValue -> Maybe FlowLayout -> IO ()
gvalueSet_ Ptr GValue
gv Maybe FlowLayout
P.Nothing = Ptr GValue -> Ptr FlowLayout -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr FlowLayout
forall a. Ptr a
FP.nullPtr :: FP.Ptr FlowLayout)
    gvalueSet_ Ptr GValue
gv (P.Just FlowLayout
obj) = FlowLayout -> (Ptr FlowLayout -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FlowLayout
obj (Ptr GValue -> Ptr FlowLayout -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe FlowLayout)
gvalueGet_ Ptr GValue
gv = do
        Ptr FlowLayout
ptr <- Ptr GValue -> IO (Ptr FlowLayout)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr FlowLayout)
        if Ptr FlowLayout
ptr Ptr FlowLayout -> Ptr FlowLayout -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr FlowLayout
forall a. Ptr a
FP.nullPtr
        then FlowLayout -> Maybe FlowLayout
forall a. a -> Maybe a
P.Just (FlowLayout -> Maybe FlowLayout)
-> IO FlowLayout -> IO (Maybe FlowLayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr FlowLayout -> FlowLayout)
-> Ptr FlowLayout -> IO FlowLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr FlowLayout -> FlowLayout
FlowLayout Ptr FlowLayout
ptr
        else Maybe FlowLayout -> IO (Maybe FlowLayout)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FlowLayout
forall a. Maybe a
P.Nothing
        
    
#if defined(ENABLE_OVERLOADING)
type family ResolveFlowLayoutMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFlowLayoutMethod "allocate" o = Clutter.LayoutManager.LayoutManagerAllocateMethodInfo
    ResolveFlowLayoutMethod "beginAnimation" o = Clutter.LayoutManager.LayoutManagerBeginAnimationMethodInfo
    ResolveFlowLayoutMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFlowLayoutMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFlowLayoutMethod "childGetProperty" o = Clutter.LayoutManager.LayoutManagerChildGetPropertyMethodInfo
    ResolveFlowLayoutMethod "childSetProperty" o = Clutter.LayoutManager.LayoutManagerChildSetPropertyMethodInfo
    ResolveFlowLayoutMethod "endAnimation" o = Clutter.LayoutManager.LayoutManagerEndAnimationMethodInfo
    ResolveFlowLayoutMethod "findChildProperty" o = Clutter.LayoutManager.LayoutManagerFindChildPropertyMethodInfo
    ResolveFlowLayoutMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFlowLayoutMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFlowLayoutMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFlowLayoutMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFlowLayoutMethod "layoutChanged" o = Clutter.LayoutManager.LayoutManagerLayoutChangedMethodInfo
    ResolveFlowLayoutMethod "listChildProperties" o = Clutter.LayoutManager.LayoutManagerListChildPropertiesMethodInfo
    ResolveFlowLayoutMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFlowLayoutMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFlowLayoutMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFlowLayoutMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFlowLayoutMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFlowLayoutMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFlowLayoutMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFlowLayoutMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFlowLayoutMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFlowLayoutMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFlowLayoutMethod "getAnimationProgress" o = Clutter.LayoutManager.LayoutManagerGetAnimationProgressMethodInfo
    ResolveFlowLayoutMethod "getChildMeta" o = Clutter.LayoutManager.LayoutManagerGetChildMetaMethodInfo
    ResolveFlowLayoutMethod "getColumnSpacing" o = FlowLayoutGetColumnSpacingMethodInfo
    ResolveFlowLayoutMethod "getColumnWidth" o = FlowLayoutGetColumnWidthMethodInfo
    ResolveFlowLayoutMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFlowLayoutMethod "getHomogeneous" o = FlowLayoutGetHomogeneousMethodInfo
    ResolveFlowLayoutMethod "getOrientation" o = FlowLayoutGetOrientationMethodInfo
    ResolveFlowLayoutMethod "getPreferredHeight" o = Clutter.LayoutManager.LayoutManagerGetPreferredHeightMethodInfo
    ResolveFlowLayoutMethod "getPreferredWidth" o = Clutter.LayoutManager.LayoutManagerGetPreferredWidthMethodInfo
    ResolveFlowLayoutMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFlowLayoutMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFlowLayoutMethod "getRowHeight" o = FlowLayoutGetRowHeightMethodInfo
    ResolveFlowLayoutMethod "getRowSpacing" o = FlowLayoutGetRowSpacingMethodInfo
    ResolveFlowLayoutMethod "getSnapToGrid" o = FlowLayoutGetSnapToGridMethodInfo
    ResolveFlowLayoutMethod "setColumnSpacing" o = FlowLayoutSetColumnSpacingMethodInfo
    ResolveFlowLayoutMethod "setColumnWidth" o = FlowLayoutSetColumnWidthMethodInfo
    ResolveFlowLayoutMethod "setContainer" o = Clutter.LayoutManager.LayoutManagerSetContainerMethodInfo
    ResolveFlowLayoutMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFlowLayoutMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFlowLayoutMethod "setHomogeneous" o = FlowLayoutSetHomogeneousMethodInfo
    ResolveFlowLayoutMethod "setOrientation" o = FlowLayoutSetOrientationMethodInfo
    ResolveFlowLayoutMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFlowLayoutMethod "setRowHeight" o = FlowLayoutSetRowHeightMethodInfo
    ResolveFlowLayoutMethod "setRowSpacing" o = FlowLayoutSetRowSpacingMethodInfo
    ResolveFlowLayoutMethod "setSnapToGrid" o = FlowLayoutSetSnapToGridMethodInfo
    ResolveFlowLayoutMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveFlowLayoutMethod t FlowLayout, O.OverloadedMethod info FlowLayout p) => OL.IsLabel t (FlowLayout -> 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 ~ ResolveFlowLayoutMethod t FlowLayout, O.OverloadedMethod info FlowLayout p, R.HasField t FlowLayout p) => R.HasField t FlowLayout p where
    getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveFlowLayoutMethod t FlowLayout, O.OverloadedMethodInfo info FlowLayout) => OL.IsLabel t (O.MethodProxy info FlowLayout) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif
#endif
   
   
   
getFlowLayoutColumnSpacing :: (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutColumnSpacing :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutColumnSpacing o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"column-spacing"
setFlowLayoutColumnSpacing :: (MonadIO m, IsFlowLayout o) => o -> Float -> m ()
setFlowLayoutColumnSpacing :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Float -> m ()
setFlowLayoutColumnSpacing o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"column-spacing" Float
val
constructFlowLayoutColumnSpacing :: (IsFlowLayout o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFlowLayoutColumnSpacing :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFlowLayoutColumnSpacing Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"column-spacing" Float
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutColumnSpacingPropertyInfo
instance AttrInfo FlowLayoutColumnSpacingPropertyInfo where
    type AttrAllowedOps FlowLayoutColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutColumnSpacingPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutColumnSpacingPropertyInfo = (~) Float
    type AttrTransferTypeConstraint FlowLayoutColumnSpacingPropertyInfo = (~) Float
    type AttrTransferType FlowLayoutColumnSpacingPropertyInfo = Float
    type AttrGetType FlowLayoutColumnSpacingPropertyInfo = Float
    type AttrLabel FlowLayoutColumnSpacingPropertyInfo = "column-spacing"
    type AttrOrigin FlowLayoutColumnSpacingPropertyInfo = FlowLayout
    attrGet = getFlowLayoutColumnSpacing
    attrSet = setFlowLayoutColumnSpacing
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutColumnSpacing
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.columnSpacing"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:columnSpacing"
        })
#endif
   
   
   
getFlowLayoutHomogeneous :: (MonadIO m, IsFlowLayout o) => o -> m Bool
getFlowLayoutHomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Bool
getFlowLayoutHomogeneous o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"homogeneous"
setFlowLayoutHomogeneous :: (MonadIO m, IsFlowLayout o) => o -> Bool -> m ()
setFlowLayoutHomogeneous :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Bool -> m ()
setFlowLayoutHomogeneous o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"homogeneous" Bool
val
constructFlowLayoutHomogeneous :: (IsFlowLayout o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructFlowLayoutHomogeneous :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructFlowLayoutHomogeneous Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"homogeneous" Bool
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutHomogeneousPropertyInfo
instance AttrInfo FlowLayoutHomogeneousPropertyInfo where
    type AttrAllowedOps FlowLayoutHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutHomogeneousPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutHomogeneousPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlowLayoutHomogeneousPropertyInfo = (~) Bool
    type AttrTransferType FlowLayoutHomogeneousPropertyInfo = Bool
    type AttrGetType FlowLayoutHomogeneousPropertyInfo = Bool
    type AttrLabel FlowLayoutHomogeneousPropertyInfo = "homogeneous"
    type AttrOrigin FlowLayoutHomogeneousPropertyInfo = FlowLayout
    attrGet = getFlowLayoutHomogeneous
    attrSet = setFlowLayoutHomogeneous
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutHomogeneous
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.homogeneous"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:homogeneous"
        })
#endif
   
   
   
getFlowLayoutMaxColumnWidth :: (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMaxColumnWidth :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMaxColumnWidth o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"max-column-width"
setFlowLayoutMaxColumnWidth :: (MonadIO m, IsFlowLayout o) => o -> Float -> m ()
setFlowLayoutMaxColumnWidth :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Float -> m ()
setFlowLayoutMaxColumnWidth o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"max-column-width" Float
val
constructFlowLayoutMaxColumnWidth :: (IsFlowLayout o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFlowLayoutMaxColumnWidth :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFlowLayoutMaxColumnWidth Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"max-column-width" Float
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutMaxColumnWidthPropertyInfo
instance AttrInfo FlowLayoutMaxColumnWidthPropertyInfo where
    type AttrAllowedOps FlowLayoutMaxColumnWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutMaxColumnWidthPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutMaxColumnWidthPropertyInfo = (~) Float
    type AttrTransferTypeConstraint FlowLayoutMaxColumnWidthPropertyInfo = (~) Float
    type AttrTransferType FlowLayoutMaxColumnWidthPropertyInfo = Float
    type AttrGetType FlowLayoutMaxColumnWidthPropertyInfo = Float
    type AttrLabel FlowLayoutMaxColumnWidthPropertyInfo = "max-column-width"
    type AttrOrigin FlowLayoutMaxColumnWidthPropertyInfo = FlowLayout
    attrGet = getFlowLayoutMaxColumnWidth
    attrSet = setFlowLayoutMaxColumnWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutMaxColumnWidth
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.maxColumnWidth"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:maxColumnWidth"
        })
#endif
   
   
   
getFlowLayoutMaxRowHeight :: (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMaxRowHeight :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMaxRowHeight o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"max-row-height"
setFlowLayoutMaxRowHeight :: (MonadIO m, IsFlowLayout o) => o -> Float -> m ()
setFlowLayoutMaxRowHeight :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Float -> m ()
setFlowLayoutMaxRowHeight o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"max-row-height" Float
val
constructFlowLayoutMaxRowHeight :: (IsFlowLayout o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFlowLayoutMaxRowHeight :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFlowLayoutMaxRowHeight Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"max-row-height" Float
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutMaxRowHeightPropertyInfo
instance AttrInfo FlowLayoutMaxRowHeightPropertyInfo where
    type AttrAllowedOps FlowLayoutMaxRowHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutMaxRowHeightPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutMaxRowHeightPropertyInfo = (~) Float
    type AttrTransferTypeConstraint FlowLayoutMaxRowHeightPropertyInfo = (~) Float
    type AttrTransferType FlowLayoutMaxRowHeightPropertyInfo = Float
    type AttrGetType FlowLayoutMaxRowHeightPropertyInfo = Float
    type AttrLabel FlowLayoutMaxRowHeightPropertyInfo = "max-row-height"
    type AttrOrigin FlowLayoutMaxRowHeightPropertyInfo = FlowLayout
    attrGet = getFlowLayoutMaxRowHeight
    attrSet = setFlowLayoutMaxRowHeight
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutMaxRowHeight
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.maxRowHeight"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:maxRowHeight"
        })
#endif
   
   
   
getFlowLayoutMinColumnWidth :: (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMinColumnWidth :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMinColumnWidth o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"min-column-width"
setFlowLayoutMinColumnWidth :: (MonadIO m, IsFlowLayout o) => o -> Float -> m ()
setFlowLayoutMinColumnWidth :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Float -> m ()
setFlowLayoutMinColumnWidth o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"min-column-width" Float
val
constructFlowLayoutMinColumnWidth :: (IsFlowLayout o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFlowLayoutMinColumnWidth :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFlowLayoutMinColumnWidth Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"min-column-width" Float
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutMinColumnWidthPropertyInfo
instance AttrInfo FlowLayoutMinColumnWidthPropertyInfo where
    type AttrAllowedOps FlowLayoutMinColumnWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutMinColumnWidthPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutMinColumnWidthPropertyInfo = (~) Float
    type AttrTransferTypeConstraint FlowLayoutMinColumnWidthPropertyInfo = (~) Float
    type AttrTransferType FlowLayoutMinColumnWidthPropertyInfo = Float
    type AttrGetType FlowLayoutMinColumnWidthPropertyInfo = Float
    type AttrLabel FlowLayoutMinColumnWidthPropertyInfo = "min-column-width"
    type AttrOrigin FlowLayoutMinColumnWidthPropertyInfo = FlowLayout
    attrGet = getFlowLayoutMinColumnWidth
    attrSet = setFlowLayoutMinColumnWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutMinColumnWidth
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.minColumnWidth"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:minColumnWidth"
        })
#endif
   
   
   
getFlowLayoutMinRowHeight :: (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMinRowHeight :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutMinRowHeight o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"min-row-height"
setFlowLayoutMinRowHeight :: (MonadIO m, IsFlowLayout o) => o -> Float -> m ()
setFlowLayoutMinRowHeight :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Float -> m ()
setFlowLayoutMinRowHeight o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"min-row-height" Float
val
constructFlowLayoutMinRowHeight :: (IsFlowLayout o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFlowLayoutMinRowHeight :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFlowLayoutMinRowHeight Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"min-row-height" Float
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutMinRowHeightPropertyInfo
instance AttrInfo FlowLayoutMinRowHeightPropertyInfo where
    type AttrAllowedOps FlowLayoutMinRowHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutMinRowHeightPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutMinRowHeightPropertyInfo = (~) Float
    type AttrTransferTypeConstraint FlowLayoutMinRowHeightPropertyInfo = (~) Float
    type AttrTransferType FlowLayoutMinRowHeightPropertyInfo = Float
    type AttrGetType FlowLayoutMinRowHeightPropertyInfo = Float
    type AttrLabel FlowLayoutMinRowHeightPropertyInfo = "min-row-height"
    type AttrOrigin FlowLayoutMinRowHeightPropertyInfo = FlowLayout
    attrGet = getFlowLayoutMinRowHeight
    attrSet = setFlowLayoutMinRowHeight
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutMinRowHeight
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.minRowHeight"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:minRowHeight"
        })
#endif
   
   
   
getFlowLayoutOrientation :: (MonadIO m, IsFlowLayout o) => o -> m Clutter.Enums.FlowOrientation
getFlowLayoutOrientation :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> m FlowOrientation
getFlowLayoutOrientation o
obj = IO FlowOrientation -> m FlowOrientation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO FlowOrientation -> m FlowOrientation)
-> IO FlowOrientation -> m FlowOrientation
forall a b. (a -> b) -> a -> b
$ o -> String -> IO FlowOrientation
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"orientation"
setFlowLayoutOrientation :: (MonadIO m, IsFlowLayout o) => o -> Clutter.Enums.FlowOrientation -> m ()
setFlowLayoutOrientation :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> FlowOrientation -> m ()
setFlowLayoutOrientation o
obj FlowOrientation
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 -> FlowOrientation -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"orientation" FlowOrientation
val
constructFlowLayoutOrientation :: (IsFlowLayout o, MIO.MonadIO m) => Clutter.Enums.FlowOrientation -> m (GValueConstruct o)
constructFlowLayoutOrientation :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
FlowOrientation -> m (GValueConstruct o)
constructFlowLayoutOrientation FlowOrientation
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 -> FlowOrientation -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"orientation" FlowOrientation
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutOrientationPropertyInfo
instance AttrInfo FlowLayoutOrientationPropertyInfo where
    type AttrAllowedOps FlowLayoutOrientationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutOrientationPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutOrientationPropertyInfo = (~) Clutter.Enums.FlowOrientation
    type AttrTransferTypeConstraint FlowLayoutOrientationPropertyInfo = (~) Clutter.Enums.FlowOrientation
    type AttrTransferType FlowLayoutOrientationPropertyInfo = Clutter.Enums.FlowOrientation
    type AttrGetType FlowLayoutOrientationPropertyInfo = Clutter.Enums.FlowOrientation
    type AttrLabel FlowLayoutOrientationPropertyInfo = "orientation"
    type AttrOrigin FlowLayoutOrientationPropertyInfo = FlowLayout
    attrGet = getFlowLayoutOrientation
    attrSet = setFlowLayoutOrientation
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutOrientation
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.orientation"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:orientation"
        })
#endif
   
   
   
getFlowLayoutRowSpacing :: (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutRowSpacing :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Float
getFlowLayoutRowSpacing o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"row-spacing"
setFlowLayoutRowSpacing :: (MonadIO m, IsFlowLayout o) => o -> Float -> m ()
setFlowLayoutRowSpacing :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Float -> m ()
setFlowLayoutRowSpacing o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"row-spacing" Float
val
constructFlowLayoutRowSpacing :: (IsFlowLayout o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFlowLayoutRowSpacing :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFlowLayoutRowSpacing Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"row-spacing" Float
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutRowSpacingPropertyInfo
instance AttrInfo FlowLayoutRowSpacingPropertyInfo where
    type AttrAllowedOps FlowLayoutRowSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutRowSpacingPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutRowSpacingPropertyInfo = (~) Float
    type AttrTransferTypeConstraint FlowLayoutRowSpacingPropertyInfo = (~) Float
    type AttrTransferType FlowLayoutRowSpacingPropertyInfo = Float
    type AttrGetType FlowLayoutRowSpacingPropertyInfo = Float
    type AttrLabel FlowLayoutRowSpacingPropertyInfo = "row-spacing"
    type AttrOrigin FlowLayoutRowSpacingPropertyInfo = FlowLayout
    attrGet = getFlowLayoutRowSpacing
    attrSet = setFlowLayoutRowSpacing
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutRowSpacing
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.rowSpacing"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:rowSpacing"
        })
#endif
   
   
   
getFlowLayoutSnapToGrid :: (MonadIO m, IsFlowLayout o) => o -> m Bool
getFlowLayoutSnapToGrid :: forall (m :: * -> *) o. (MonadIO m, IsFlowLayout o) => o -> m Bool
getFlowLayoutSnapToGrid o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"snap-to-grid"
setFlowLayoutSnapToGrid :: (MonadIO m, IsFlowLayout o) => o -> Bool -> m ()
setFlowLayoutSnapToGrid :: forall (m :: * -> *) o.
(MonadIO m, IsFlowLayout o) =>
o -> Bool -> m ()
setFlowLayoutSnapToGrid o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"snap-to-grid" Bool
val
constructFlowLayoutSnapToGrid :: (IsFlowLayout o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructFlowLayoutSnapToGrid :: forall o (m :: * -> *).
(IsFlowLayout o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructFlowLayoutSnapToGrid Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"snap-to-grid" Bool
val
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSnapToGridPropertyInfo
instance AttrInfo FlowLayoutSnapToGridPropertyInfo where
    type AttrAllowedOps FlowLayoutSnapToGridPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlowLayoutSnapToGridPropertyInfo = IsFlowLayout
    type AttrSetTypeConstraint FlowLayoutSnapToGridPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlowLayoutSnapToGridPropertyInfo = (~) Bool
    type AttrTransferType FlowLayoutSnapToGridPropertyInfo = Bool
    type AttrGetType FlowLayoutSnapToGridPropertyInfo = Bool
    type AttrLabel FlowLayoutSnapToGridPropertyInfo = "snap-to-grid"
    type AttrOrigin FlowLayoutSnapToGridPropertyInfo = FlowLayout
    attrGet = getFlowLayoutSnapToGrid
    attrSet = setFlowLayoutSnapToGrid
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlowLayoutSnapToGrid
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.snapToGrid"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#g:attr:snapToGrid"
        })
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FlowLayout
type instance O.AttributeList FlowLayout = FlowLayoutAttributeList
type FlowLayoutAttributeList = ('[ '("columnSpacing", FlowLayoutColumnSpacingPropertyInfo), '("homogeneous", FlowLayoutHomogeneousPropertyInfo), '("maxColumnWidth", FlowLayoutMaxColumnWidthPropertyInfo), '("maxRowHeight", FlowLayoutMaxRowHeightPropertyInfo), '("minColumnWidth", FlowLayoutMinColumnWidthPropertyInfo), '("minRowHeight", FlowLayoutMinRowHeightPropertyInfo), '("orientation", FlowLayoutOrientationPropertyInfo), '("rowSpacing", FlowLayoutRowSpacingPropertyInfo), '("snapToGrid", FlowLayoutSnapToGridPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
flowLayoutColumnSpacing :: AttrLabelProxy "columnSpacing"
flowLayoutColumnSpacing = AttrLabelProxy
flowLayoutHomogeneous :: AttrLabelProxy "homogeneous"
flowLayoutHomogeneous = AttrLabelProxy
flowLayoutMaxColumnWidth :: AttrLabelProxy "maxColumnWidth"
flowLayoutMaxColumnWidth = AttrLabelProxy
flowLayoutMaxRowHeight :: AttrLabelProxy "maxRowHeight"
flowLayoutMaxRowHeight = AttrLabelProxy
flowLayoutMinColumnWidth :: AttrLabelProxy "minColumnWidth"
flowLayoutMinColumnWidth = AttrLabelProxy
flowLayoutMinRowHeight :: AttrLabelProxy "minRowHeight"
flowLayoutMinRowHeight = AttrLabelProxy
flowLayoutOrientation :: AttrLabelProxy "orientation"
flowLayoutOrientation = AttrLabelProxy
flowLayoutRowSpacing :: AttrLabelProxy "rowSpacing"
flowLayoutRowSpacing = AttrLabelProxy
flowLayoutSnapToGrid :: AttrLabelProxy "snapToGrid"
flowLayoutSnapToGrid = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList FlowLayout = FlowLayoutSignalList
type FlowLayoutSignalList = ('[ '("layoutChanged", Clutter.LayoutManager.LayoutManagerLayoutChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "clutter_flow_layout_new" clutter_flow_layout_new :: 
    CUInt ->                                
    IO (Ptr FlowLayout)
flowLayoutNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Clutter.Enums.FlowOrientation
    
    -> m FlowLayout
    
flowLayoutNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FlowOrientation -> m FlowLayout
flowLayoutNew FlowOrientation
orientation = IO FlowLayout -> m FlowLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowLayout -> m FlowLayout) -> IO FlowLayout -> m FlowLayout
forall a b. (a -> b) -> a -> b
$ do
    let orientation' :: CUInt
orientation' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FlowOrientation -> Int) -> FlowOrientation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowOrientation -> Int
forall a. Enum a => a -> Int
fromEnum) FlowOrientation
orientation
    Ptr FlowLayout
result <- CUInt -> IO (Ptr FlowLayout)
clutter_flow_layout_new CUInt
orientation'
    Text -> Ptr FlowLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"flowLayoutNew" Ptr FlowLayout
result
    FlowLayout
result' <- ((ManagedPtr FlowLayout -> FlowLayout)
-> Ptr FlowLayout -> IO FlowLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FlowLayout -> FlowLayout
FlowLayout) Ptr FlowLayout
result
    FlowLayout -> IO FlowLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowLayout
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "clutter_flow_layout_get_column_spacing" clutter_flow_layout_get_column_spacing :: 
    Ptr FlowLayout ->                       
    IO CFloat
flowLayoutGetColumnSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m Float
    
    
flowLayoutGetColumnSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m Float
flowLayoutGetColumnSpacing a
layout = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    CFloat
result <- Ptr FlowLayout -> IO CFloat
clutter_flow_layout_get_column_spacing Ptr FlowLayout
layout'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetColumnSpacingMethodInfo
instance (signature ~ (m Float), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetColumnSpacingMethodInfo a signature where
    overloadedMethod = flowLayoutGetColumnSpacing
instance O.OverloadedMethodInfo FlowLayoutGetColumnSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetColumnSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetColumnSpacing"
        })
#endif
foreign import ccall "clutter_flow_layout_get_column_width" clutter_flow_layout_get_column_width :: 
    Ptr FlowLayout ->                       
    Ptr CFloat ->                           
    Ptr CFloat ->                           
    IO ()
flowLayoutGetColumnWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m ((Float, Float))
flowLayoutGetColumnWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m (Float, Float)
flowLayoutGetColumnWidth a
layout = IO (Float, Float) -> m (Float, Float)
forall a. IO a -> m a
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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    Ptr CFloat
minWidth <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
maxWidth <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr FlowLayout -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_flow_layout_get_column_width Ptr FlowLayout
layout' Ptr CFloat
minWidth Ptr CFloat
maxWidth
    CFloat
minWidth' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
minWidth
    let minWidth'' :: Float
minWidth'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
minWidth'
    CFloat
maxWidth' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
maxWidth
    let maxWidth'' :: Float
maxWidth'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
maxWidth'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
minWidth
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
maxWidth
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
minWidth'', Float
maxWidth'')
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetColumnWidthMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetColumnWidthMethodInfo a signature where
    overloadedMethod = flowLayoutGetColumnWidth
instance O.OverloadedMethodInfo FlowLayoutGetColumnWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetColumnWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetColumnWidth"
        })
#endif
foreign import ccall "clutter_flow_layout_get_homogeneous" clutter_flow_layout_get_homogeneous :: 
    Ptr FlowLayout ->                       
    IO CInt
flowLayoutGetHomogeneous ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m Bool
    
flowLayoutGetHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m Bool
flowLayoutGetHomogeneous a
layout = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    CInt
result <- Ptr FlowLayout -> IO CInt
clutter_flow_layout_get_homogeneous Ptr FlowLayout
layout'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetHomogeneousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetHomogeneousMethodInfo a signature where
    overloadedMethod = flowLayoutGetHomogeneous
instance O.OverloadedMethodInfo FlowLayoutGetHomogeneousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetHomogeneous",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetHomogeneous"
        })
#endif
foreign import ccall "clutter_flow_layout_get_orientation" clutter_flow_layout_get_orientation :: 
    Ptr FlowLayout ->                       
    IO CUInt
flowLayoutGetOrientation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m Clutter.Enums.FlowOrientation
    
flowLayoutGetOrientation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m FlowOrientation
flowLayoutGetOrientation a
layout = IO FlowOrientation -> m FlowOrientation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowOrientation -> m FlowOrientation)
-> IO FlowOrientation -> m FlowOrientation
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    CUInt
result <- Ptr FlowLayout -> IO CUInt
clutter_flow_layout_get_orientation Ptr FlowLayout
layout'
    let result' :: FlowOrientation
result' = (Int -> FlowOrientation
forall a. Enum a => Int -> a
toEnum (Int -> FlowOrientation)
-> (CUInt -> Int) -> CUInt -> FlowOrientation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    FlowOrientation -> IO FlowOrientation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowOrientation
result'
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetOrientationMethodInfo
instance (signature ~ (m Clutter.Enums.FlowOrientation), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetOrientationMethodInfo a signature where
    overloadedMethod = flowLayoutGetOrientation
instance O.OverloadedMethodInfo FlowLayoutGetOrientationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetOrientation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetOrientation"
        })
#endif
foreign import ccall "clutter_flow_layout_get_row_height" clutter_flow_layout_get_row_height :: 
    Ptr FlowLayout ->                       
    Ptr CFloat ->                           
    Ptr CFloat ->                           
    IO ()
flowLayoutGetRowHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m ((Float, Float))
flowLayoutGetRowHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m (Float, Float)
flowLayoutGetRowHeight a
layout = IO (Float, Float) -> m (Float, Float)
forall a. IO a -> m a
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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    Ptr CFloat
minHeight <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
maxHeight <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr FlowLayout -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_flow_layout_get_row_height Ptr FlowLayout
layout' Ptr CFloat
minHeight Ptr CFloat
maxHeight
    CFloat
minHeight' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
minHeight
    let minHeight'' :: Float
minHeight'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
minHeight'
    CFloat
maxHeight' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
maxHeight
    let maxHeight'' :: Float
maxHeight'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
maxHeight'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
minHeight
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
maxHeight
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
minHeight'', Float
maxHeight'')
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetRowHeightMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetRowHeightMethodInfo a signature where
    overloadedMethod = flowLayoutGetRowHeight
instance O.OverloadedMethodInfo FlowLayoutGetRowHeightMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetRowHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetRowHeight"
        })
#endif
foreign import ccall "clutter_flow_layout_get_row_spacing" clutter_flow_layout_get_row_spacing :: 
    Ptr FlowLayout ->                       
    IO CFloat
flowLayoutGetRowSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m Float
    
    
flowLayoutGetRowSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m Float
flowLayoutGetRowSpacing a
layout = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    CFloat
result <- Ptr FlowLayout -> IO CFloat
clutter_flow_layout_get_row_spacing Ptr FlowLayout
layout'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetRowSpacingMethodInfo
instance (signature ~ (m Float), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetRowSpacingMethodInfo a signature where
    overloadedMethod = flowLayoutGetRowSpacing
instance O.OverloadedMethodInfo FlowLayoutGetRowSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetRowSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetRowSpacing"
        })
#endif
foreign import ccall "clutter_flow_layout_get_snap_to_grid" clutter_flow_layout_get_snap_to_grid :: 
    Ptr FlowLayout ->                       
    IO CInt
flowLayoutGetSnapToGrid ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> m Bool
    
flowLayoutGetSnapToGrid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> m Bool
flowLayoutGetSnapToGrid a
layout = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    CInt
result <- Ptr FlowLayout -> IO CInt
clutter_flow_layout_get_snap_to_grid Ptr FlowLayout
layout'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data FlowLayoutGetSnapToGridMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutGetSnapToGridMethodInfo a signature where
    overloadedMethod = flowLayoutGetSnapToGrid
instance O.OverloadedMethodInfo FlowLayoutGetSnapToGridMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutGetSnapToGrid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutGetSnapToGrid"
        })
#endif
foreign import ccall "clutter_flow_layout_set_column_spacing" clutter_flow_layout_set_column_spacing :: 
    Ptr FlowLayout ->                       
    CFloat ->                               
    IO ()
flowLayoutSetColumnSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Float
    
    -> m ()
flowLayoutSetColumnSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> Float -> m ()
flowLayoutSetColumnSpacing a
layout Float
spacing = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let spacing' :: CFloat
spacing' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing
    Ptr FlowLayout -> CFloat -> IO ()
clutter_flow_layout_set_column_spacing Ptr FlowLayout
layout' CFloat
spacing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetColumnSpacingMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetColumnSpacingMethodInfo a signature where
    overloadedMethod = flowLayoutSetColumnSpacing
instance O.OverloadedMethodInfo FlowLayoutSetColumnSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetColumnSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetColumnSpacing"
        })
#endif
foreign import ccall "clutter_flow_layout_set_column_width" clutter_flow_layout_set_column_width :: 
    Ptr FlowLayout ->                       
    CFloat ->                               
    CFloat ->                               
    IO ()
flowLayoutSetColumnWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Float
    
    -> Float
    
    -> m ()
flowLayoutSetColumnWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> Float -> Float -> m ()
flowLayoutSetColumnWidth a
layout Float
minWidth Float
maxWidth = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let minWidth' :: CFloat
minWidth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
minWidth
    let maxWidth' :: CFloat
maxWidth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
maxWidth
    Ptr FlowLayout -> CFloat -> CFloat -> IO ()
clutter_flow_layout_set_column_width Ptr FlowLayout
layout' CFloat
minWidth' CFloat
maxWidth'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetColumnWidthMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetColumnWidthMethodInfo a signature where
    overloadedMethod = flowLayoutSetColumnWidth
instance O.OverloadedMethodInfo FlowLayoutSetColumnWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetColumnWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetColumnWidth"
        })
#endif
foreign import ccall "clutter_flow_layout_set_homogeneous" clutter_flow_layout_set_homogeneous :: 
    Ptr FlowLayout ->                       
    CInt ->                                 
    IO ()
flowLayoutSetHomogeneous ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Bool
    
    -> m ()
flowLayoutSetHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> Bool -> m ()
flowLayoutSetHomogeneous a
layout Bool
homogeneous = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let homogeneous' :: CInt
homogeneous' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
homogeneous
    Ptr FlowLayout -> CInt -> IO ()
clutter_flow_layout_set_homogeneous Ptr FlowLayout
layout' CInt
homogeneous'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetHomogeneousMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetHomogeneousMethodInfo a signature where
    overloadedMethod = flowLayoutSetHomogeneous
instance O.OverloadedMethodInfo FlowLayoutSetHomogeneousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetHomogeneous",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetHomogeneous"
        })
#endif
foreign import ccall "clutter_flow_layout_set_orientation" clutter_flow_layout_set_orientation :: 
    Ptr FlowLayout ->                       
    CUInt ->                                
    IO ()
flowLayoutSetOrientation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Clutter.Enums.FlowOrientation
    
    -> m ()
flowLayoutSetOrientation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> FlowOrientation -> m ()
flowLayoutSetOrientation a
layout FlowOrientation
orientation = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let orientation' :: CUInt
orientation' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FlowOrientation -> Int) -> FlowOrientation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowOrientation -> Int
forall a. Enum a => a -> Int
fromEnum) FlowOrientation
orientation
    Ptr FlowLayout -> CUInt -> IO ()
clutter_flow_layout_set_orientation Ptr FlowLayout
layout' CUInt
orientation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetOrientationMethodInfo
instance (signature ~ (Clutter.Enums.FlowOrientation -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetOrientationMethodInfo a signature where
    overloadedMethod = flowLayoutSetOrientation
instance O.OverloadedMethodInfo FlowLayoutSetOrientationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetOrientation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetOrientation"
        })
#endif
foreign import ccall "clutter_flow_layout_set_row_height" clutter_flow_layout_set_row_height :: 
    Ptr FlowLayout ->                       
    CFloat ->                               
    CFloat ->                               
    IO ()
flowLayoutSetRowHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Float
    
    -> Float
    
    -> m ()
flowLayoutSetRowHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> Float -> Float -> m ()
flowLayoutSetRowHeight a
layout Float
minHeight Float
maxHeight = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let minHeight' :: CFloat
minHeight' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
minHeight
    let maxHeight' :: CFloat
maxHeight' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
maxHeight
    Ptr FlowLayout -> CFloat -> CFloat -> IO ()
clutter_flow_layout_set_row_height Ptr FlowLayout
layout' CFloat
minHeight' CFloat
maxHeight'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetRowHeightMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetRowHeightMethodInfo a signature where
    overloadedMethod = flowLayoutSetRowHeight
instance O.OverloadedMethodInfo FlowLayoutSetRowHeightMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetRowHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetRowHeight"
        })
#endif
foreign import ccall "clutter_flow_layout_set_row_spacing" clutter_flow_layout_set_row_spacing :: 
    Ptr FlowLayout ->                       
    CFloat ->                               
    IO ()
flowLayoutSetRowSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Float
    
    -> m ()
flowLayoutSetRowSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> Float -> m ()
flowLayoutSetRowSpacing a
layout Float
spacing = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let spacing' :: CFloat
spacing' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing
    Ptr FlowLayout -> CFloat -> IO ()
clutter_flow_layout_set_row_spacing Ptr FlowLayout
layout' CFloat
spacing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetRowSpacingMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetRowSpacingMethodInfo a signature where
    overloadedMethod = flowLayoutSetRowSpacing
instance O.OverloadedMethodInfo FlowLayoutSetRowSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetRowSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetRowSpacing"
        })
#endif
foreign import ccall "clutter_flow_layout_set_snap_to_grid" clutter_flow_layout_set_snap_to_grid :: 
    Ptr FlowLayout ->                       
    CInt ->                                 
    IO ()
flowLayoutSetSnapToGrid ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlowLayout a) =>
    a
    
    -> Bool
    
    -> m ()
flowLayoutSetSnapToGrid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlowLayout a) =>
a -> Bool -> m ()
flowLayoutSetSnapToGrid a
layout Bool
snapToGrid = 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 FlowLayout
layout' <- a -> IO (Ptr FlowLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
    let snapToGrid' :: CInt
snapToGrid' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
snapToGrid
    Ptr FlowLayout -> CInt -> IO ()
clutter_flow_layout_set_snap_to_grid Ptr FlowLayout
layout' CInt
snapToGrid'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data FlowLayoutSetSnapToGridMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlowLayout a) => O.OverloadedMethod FlowLayoutSetSnapToGridMethodInfo a signature where
    overloadedMethod = flowLayoutSetSnapToGrid
instance O.OverloadedMethodInfo FlowLayoutSetSnapToGridMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.FlowLayout.flowLayoutSetSnapToGrid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-FlowLayout.html#v:flowLayoutSetSnapToGrid"
        })
#endif