{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.GridLayout
    ( 
    GridLayout(..)                          ,
    IsGridLayout                            ,
    toGridLayout                            ,
 
#if defined(ENABLE_OVERLOADING)
    ResolveGridLayoutMethod                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    GridLayoutGetBaselineRowMethodInfo      ,
#endif
    gridLayoutGetBaselineRow                ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutGetColumnHomogeneousMethodInfo,
#endif
    gridLayoutGetColumnHomogeneous          ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutGetColumnSpacingMethodInfo    ,
#endif
    gridLayoutGetColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutGetRowBaselinePositionMethodInfo,
#endif
    gridLayoutGetRowBaselinePosition        ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutGetRowHomogeneousMethodInfo   ,
#endif
    gridLayoutGetRowHomogeneous             ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutGetRowSpacingMethodInfo       ,
#endif
    gridLayoutGetRowSpacing                 ,
    gridLayoutNew                           ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutSetBaselineRowMethodInfo      ,
#endif
    gridLayoutSetBaselineRow                ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutSetColumnHomogeneousMethodInfo,
#endif
    gridLayoutSetColumnHomogeneous          ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutSetColumnSpacingMethodInfo    ,
#endif
    gridLayoutSetColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutSetRowBaselinePositionMethodInfo,
#endif
    gridLayoutSetRowBaselinePosition        ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutSetRowHomogeneousMethodInfo   ,
#endif
    gridLayoutSetRowHomogeneous             ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutSetRowSpacingMethodInfo       ,
#endif
    gridLayoutSetRowSpacing                 ,
 
#if defined(ENABLE_OVERLOADING)
    GridLayoutBaselineRowPropertyInfo       ,
#endif
    constructGridLayoutBaselineRow          ,
    getGridLayoutBaselineRow                ,
#if defined(ENABLE_OVERLOADING)
    gridLayoutBaselineRow                   ,
#endif
    setGridLayoutBaselineRow                ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutColumnHomogeneousPropertyInfo ,
#endif
    constructGridLayoutColumnHomogeneous    ,
    getGridLayoutColumnHomogeneous          ,
#if defined(ENABLE_OVERLOADING)
    gridLayoutColumnHomogeneous             ,
#endif
    setGridLayoutColumnHomogeneous          ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutColumnSpacingPropertyInfo     ,
#endif
    constructGridLayoutColumnSpacing        ,
    getGridLayoutColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    gridLayoutColumnSpacing                 ,
#endif
    setGridLayoutColumnSpacing              ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutRowHomogeneousPropertyInfo    ,
#endif
    constructGridLayoutRowHomogeneous       ,
    getGridLayoutRowHomogeneous             ,
#if defined(ENABLE_OVERLOADING)
    gridLayoutRowHomogeneous                ,
#endif
    setGridLayoutRowHomogeneous             ,
#if defined(ENABLE_OVERLOADING)
    GridLayoutRowSpacingPropertyInfo        ,
#endif
    constructGridLayoutRowSpacing           ,
    getGridLayoutRowSpacing                 ,
#if defined(ENABLE_OVERLOADING)
    gridLayoutRowSpacing                    ,
#endif
    setGridLayoutRowSpacing                 ,
    ) 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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
newtype GridLayout = GridLayout (SP.ManagedPtr GridLayout)
    deriving (GridLayout -> GridLayout -> Bool
(GridLayout -> GridLayout -> Bool)
-> (GridLayout -> GridLayout -> Bool) -> Eq GridLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridLayout -> GridLayout -> Bool
== :: GridLayout -> GridLayout -> Bool
$c/= :: GridLayout -> GridLayout -> Bool
/= :: GridLayout -> GridLayout -> Bool
Eq)
instance SP.ManagedPtrNewtype GridLayout where
    toManagedPtr :: GridLayout -> ManagedPtr GridLayout
toManagedPtr (GridLayout ManagedPtr GridLayout
p) = ManagedPtr GridLayout
p
foreign import ccall "gtk_grid_layout_get_type"
    c_gtk_grid_layout_get_type :: IO B.Types.GType
instance B.Types.TypedObject GridLayout where
    glibType :: IO GType
glibType = IO GType
c_gtk_grid_layout_get_type
instance B.Types.GObject GridLayout
class (SP.GObject o, O.IsDescendantOf GridLayout o) => IsGridLayout o
instance (SP.GObject o, O.IsDescendantOf GridLayout o) => IsGridLayout o
instance O.HasParentTypes GridLayout
type instance O.ParentTypes GridLayout = '[Gtk.LayoutManager.LayoutManager, GObject.Object.Object]
toGridLayout :: (MIO.MonadIO m, IsGridLayout o) => o -> m GridLayout
toGridLayout :: forall (m :: * -> *) o.
(MonadIO m, IsGridLayout o) =>
o -> m GridLayout
toGridLayout = IO GridLayout -> m GridLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO GridLayout -> m GridLayout)
-> (o -> IO GridLayout) -> o -> m GridLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr GridLayout -> GridLayout) -> o -> IO GridLayout
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr GridLayout -> GridLayout
GridLayout
instance B.GValue.IsGValue (Maybe GridLayout) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_grid_layout_get_type
    gvalueSet_ :: Ptr GValue -> Maybe GridLayout -> IO ()
gvalueSet_ Ptr GValue
gv Maybe GridLayout
P.Nothing = Ptr GValue -> Ptr GridLayout -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr GridLayout
forall a. Ptr a
FP.nullPtr :: FP.Ptr GridLayout)
    gvalueSet_ Ptr GValue
gv (P.Just GridLayout
obj) = GridLayout -> (Ptr GridLayout -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr GridLayout
obj (Ptr GValue -> Ptr GridLayout -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe GridLayout)
gvalueGet_ Ptr GValue
gv = do
        Ptr GridLayout
ptr <- Ptr GValue -> IO (Ptr GridLayout)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr GridLayout)
        if Ptr GridLayout
ptr Ptr GridLayout -> Ptr GridLayout -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr GridLayout
forall a. Ptr a
FP.nullPtr
        then GridLayout -> Maybe GridLayout
forall a. a -> Maybe a
P.Just (GridLayout -> Maybe GridLayout)
-> IO GridLayout -> IO (Maybe GridLayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr GridLayout -> GridLayout)
-> Ptr GridLayout -> IO GridLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr GridLayout -> GridLayout
GridLayout Ptr GridLayout
ptr
        else Maybe GridLayout -> IO (Maybe GridLayout)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GridLayout
forall a. Maybe a
P.Nothing
        
    
#if defined(ENABLE_OVERLOADING)
type family ResolveGridLayoutMethod (t :: Symbol) (o :: *) :: * where
    ResolveGridLayoutMethod "allocate" o = Gtk.LayoutManager.LayoutManagerAllocateMethodInfo
    ResolveGridLayoutMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveGridLayoutMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveGridLayoutMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveGridLayoutMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveGridLayoutMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveGridLayoutMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveGridLayoutMethod "layoutChanged" o = Gtk.LayoutManager.LayoutManagerLayoutChangedMethodInfo
    ResolveGridLayoutMethod "measure" o = Gtk.LayoutManager.LayoutManagerMeasureMethodInfo
    ResolveGridLayoutMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveGridLayoutMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveGridLayoutMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveGridLayoutMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveGridLayoutMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveGridLayoutMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveGridLayoutMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveGridLayoutMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveGridLayoutMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveGridLayoutMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveGridLayoutMethod "getBaselineRow" o = GridLayoutGetBaselineRowMethodInfo
    ResolveGridLayoutMethod "getColumnHomogeneous" o = GridLayoutGetColumnHomogeneousMethodInfo
    ResolveGridLayoutMethod "getColumnSpacing" o = GridLayoutGetColumnSpacingMethodInfo
    ResolveGridLayoutMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveGridLayoutMethod "getLayoutChild" o = Gtk.LayoutManager.LayoutManagerGetLayoutChildMethodInfo
    ResolveGridLayoutMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveGridLayoutMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveGridLayoutMethod "getRequestMode" o = Gtk.LayoutManager.LayoutManagerGetRequestModeMethodInfo
    ResolveGridLayoutMethod "getRowBaselinePosition" o = GridLayoutGetRowBaselinePositionMethodInfo
    ResolveGridLayoutMethod "getRowHomogeneous" o = GridLayoutGetRowHomogeneousMethodInfo
    ResolveGridLayoutMethod "getRowSpacing" o = GridLayoutGetRowSpacingMethodInfo
    ResolveGridLayoutMethod "getWidget" o = Gtk.LayoutManager.LayoutManagerGetWidgetMethodInfo
    ResolveGridLayoutMethod "setBaselineRow" o = GridLayoutSetBaselineRowMethodInfo
    ResolveGridLayoutMethod "setColumnHomogeneous" o = GridLayoutSetColumnHomogeneousMethodInfo
    ResolveGridLayoutMethod "setColumnSpacing" o = GridLayoutSetColumnSpacingMethodInfo
    ResolveGridLayoutMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveGridLayoutMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveGridLayoutMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveGridLayoutMethod "setRowBaselinePosition" o = GridLayoutSetRowBaselinePositionMethodInfo
    ResolveGridLayoutMethod "setRowHomogeneous" o = GridLayoutSetRowHomogeneousMethodInfo
    ResolveGridLayoutMethod "setRowSpacing" o = GridLayoutSetRowSpacingMethodInfo
    ResolveGridLayoutMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveGridLayoutMethod t GridLayout, O.OverloadedMethod info GridLayout p) => OL.IsLabel t (GridLayout -> 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 ~ ResolveGridLayoutMethod t GridLayout, O.OverloadedMethod info GridLayout p, R.HasField t GridLayout p) => R.HasField t GridLayout p where
    getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveGridLayoutMethod t GridLayout, O.OverloadedMethodInfo info GridLayout) => OL.IsLabel t (O.MethodProxy info GridLayout) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif
#endif
   
   
   
getGridLayoutBaselineRow :: (MonadIO m, IsGridLayout o) => o -> m Int32
getGridLayoutBaselineRow :: forall (m :: * -> *) o. (MonadIO m, IsGridLayout o) => o -> m Int32
getGridLayoutBaselineRow o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"baseline-row"
setGridLayoutBaselineRow :: (MonadIO m, IsGridLayout o) => o -> Int32 -> m ()
setGridLayoutBaselineRow :: forall (m :: * -> *) o.
(MonadIO m, IsGridLayout o) =>
o -> Int32 -> m ()
setGridLayoutBaselineRow o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"baseline-row" Int32
val
constructGridLayoutBaselineRow :: (IsGridLayout o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructGridLayoutBaselineRow :: forall o (m :: * -> *).
(IsGridLayout o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructGridLayoutBaselineRow Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"baseline-row" Int32
val
#if defined(ENABLE_OVERLOADING)
data GridLayoutBaselineRowPropertyInfo
instance AttrInfo GridLayoutBaselineRowPropertyInfo where
    type AttrAllowedOps GridLayoutBaselineRowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GridLayoutBaselineRowPropertyInfo = IsGridLayout
    type AttrSetTypeConstraint GridLayoutBaselineRowPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint GridLayoutBaselineRowPropertyInfo = (~) Int32
    type AttrTransferType GridLayoutBaselineRowPropertyInfo = Int32
    type AttrGetType GridLayoutBaselineRowPropertyInfo = Int32
    type AttrLabel GridLayoutBaselineRowPropertyInfo = "baseline-row"
    type AttrOrigin GridLayoutBaselineRowPropertyInfo = GridLayout
    attrGet = getGridLayoutBaselineRow
    attrSet = setGridLayoutBaselineRow
    attrTransfer _ v = do
        return v
    attrConstruct = constructGridLayoutBaselineRow
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.baselineRow"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#g:attr:baselineRow"
        })
#endif
   
   
   
getGridLayoutColumnHomogeneous :: (MonadIO m, IsGridLayout o) => o -> m Bool
getGridLayoutColumnHomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsGridLayout o) => o -> m Bool
getGridLayoutColumnHomogeneous 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
"column-homogeneous"
setGridLayoutColumnHomogeneous :: (MonadIO m, IsGridLayout o) => o -> Bool -> m ()
setGridLayoutColumnHomogeneous :: forall (m :: * -> *) o.
(MonadIO m, IsGridLayout o) =>
o -> Bool -> m ()
setGridLayoutColumnHomogeneous 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
"column-homogeneous" Bool
val
constructGridLayoutColumnHomogeneous :: (IsGridLayout o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructGridLayoutColumnHomogeneous :: forall o (m :: * -> *).
(IsGridLayout o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructGridLayoutColumnHomogeneous 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
"column-homogeneous" Bool
val
#if defined(ENABLE_OVERLOADING)
data GridLayoutColumnHomogeneousPropertyInfo
instance AttrInfo GridLayoutColumnHomogeneousPropertyInfo where
    type AttrAllowedOps GridLayoutColumnHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GridLayoutColumnHomogeneousPropertyInfo = IsGridLayout
    type AttrSetTypeConstraint GridLayoutColumnHomogeneousPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint GridLayoutColumnHomogeneousPropertyInfo = (~) Bool
    type AttrTransferType GridLayoutColumnHomogeneousPropertyInfo = Bool
    type AttrGetType GridLayoutColumnHomogeneousPropertyInfo = Bool
    type AttrLabel GridLayoutColumnHomogeneousPropertyInfo = "column-homogeneous"
    type AttrOrigin GridLayoutColumnHomogeneousPropertyInfo = GridLayout
    attrGet = getGridLayoutColumnHomogeneous
    attrSet = setGridLayoutColumnHomogeneous
    attrTransfer _ v = do
        return v
    attrConstruct = constructGridLayoutColumnHomogeneous
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.columnHomogeneous"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#g:attr:columnHomogeneous"
        })
#endif
   
   
   
getGridLayoutColumnSpacing :: (MonadIO m, IsGridLayout o) => o -> m Int32
getGridLayoutColumnSpacing :: forall (m :: * -> *) o. (MonadIO m, IsGridLayout o) => o -> m Int32
getGridLayoutColumnSpacing o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"column-spacing"
setGridLayoutColumnSpacing :: (MonadIO m, IsGridLayout o) => o -> Int32 -> m ()
setGridLayoutColumnSpacing :: forall (m :: * -> *) o.
(MonadIO m, IsGridLayout o) =>
o -> Int32 -> m ()
setGridLayoutColumnSpacing o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"column-spacing" Int32
val
constructGridLayoutColumnSpacing :: (IsGridLayout o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructGridLayoutColumnSpacing :: forall o (m :: * -> *).
(IsGridLayout o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructGridLayoutColumnSpacing Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"column-spacing" Int32
val
#if defined(ENABLE_OVERLOADING)
data GridLayoutColumnSpacingPropertyInfo
instance AttrInfo GridLayoutColumnSpacingPropertyInfo where
    type AttrAllowedOps GridLayoutColumnSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GridLayoutColumnSpacingPropertyInfo = IsGridLayout
    type AttrSetTypeConstraint GridLayoutColumnSpacingPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint GridLayoutColumnSpacingPropertyInfo = (~) Int32
    type AttrTransferType GridLayoutColumnSpacingPropertyInfo = Int32
    type AttrGetType GridLayoutColumnSpacingPropertyInfo = Int32
    type AttrLabel GridLayoutColumnSpacingPropertyInfo = "column-spacing"
    type AttrOrigin GridLayoutColumnSpacingPropertyInfo = GridLayout
    attrGet = getGridLayoutColumnSpacing
    attrSet = setGridLayoutColumnSpacing
    attrTransfer _ v = do
        return v
    attrConstruct = constructGridLayoutColumnSpacing
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.columnSpacing"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#g:attr:columnSpacing"
        })
#endif
   
   
   
getGridLayoutRowHomogeneous :: (MonadIO m, IsGridLayout o) => o -> m Bool
getGridLayoutRowHomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsGridLayout o) => o -> m Bool
getGridLayoutRowHomogeneous 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
"row-homogeneous"
setGridLayoutRowHomogeneous :: (MonadIO m, IsGridLayout o) => o -> Bool -> m ()
setGridLayoutRowHomogeneous :: forall (m :: * -> *) o.
(MonadIO m, IsGridLayout o) =>
o -> Bool -> m ()
setGridLayoutRowHomogeneous 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
"row-homogeneous" Bool
val
constructGridLayoutRowHomogeneous :: (IsGridLayout o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructGridLayoutRowHomogeneous :: forall o (m :: * -> *).
(IsGridLayout o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructGridLayoutRowHomogeneous 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
"row-homogeneous" Bool
val
#if defined(ENABLE_OVERLOADING)
data GridLayoutRowHomogeneousPropertyInfo
instance AttrInfo GridLayoutRowHomogeneousPropertyInfo where
    type AttrAllowedOps GridLayoutRowHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GridLayoutRowHomogeneousPropertyInfo = IsGridLayout
    type AttrSetTypeConstraint GridLayoutRowHomogeneousPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint GridLayoutRowHomogeneousPropertyInfo = (~) Bool
    type AttrTransferType GridLayoutRowHomogeneousPropertyInfo = Bool
    type AttrGetType GridLayoutRowHomogeneousPropertyInfo = Bool
    type AttrLabel GridLayoutRowHomogeneousPropertyInfo = "row-homogeneous"
    type AttrOrigin GridLayoutRowHomogeneousPropertyInfo = GridLayout
    attrGet = getGridLayoutRowHomogeneous
    attrSet = setGridLayoutRowHomogeneous
    attrTransfer _ v = do
        return v
    attrConstruct = constructGridLayoutRowHomogeneous
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.rowHomogeneous"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#g:attr:rowHomogeneous"
        })
#endif
   
   
   
getGridLayoutRowSpacing :: (MonadIO m, IsGridLayout o) => o -> m Int32
getGridLayoutRowSpacing :: forall (m :: * -> *) o. (MonadIO m, IsGridLayout o) => o -> m Int32
getGridLayoutRowSpacing o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"row-spacing"
setGridLayoutRowSpacing :: (MonadIO m, IsGridLayout o) => o -> Int32 -> m ()
setGridLayoutRowSpacing :: forall (m :: * -> *) o.
(MonadIO m, IsGridLayout o) =>
o -> Int32 -> m ()
setGridLayoutRowSpacing o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"row-spacing" Int32
val
constructGridLayoutRowSpacing :: (IsGridLayout o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructGridLayoutRowSpacing :: forall o (m :: * -> *).
(IsGridLayout o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructGridLayoutRowSpacing Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"row-spacing" Int32
val
#if defined(ENABLE_OVERLOADING)
data GridLayoutRowSpacingPropertyInfo
instance AttrInfo GridLayoutRowSpacingPropertyInfo where
    type AttrAllowedOps GridLayoutRowSpacingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GridLayoutRowSpacingPropertyInfo = IsGridLayout
    type AttrSetTypeConstraint GridLayoutRowSpacingPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint GridLayoutRowSpacingPropertyInfo = (~) Int32
    type AttrTransferType GridLayoutRowSpacingPropertyInfo = Int32
    type AttrGetType GridLayoutRowSpacingPropertyInfo = Int32
    type AttrLabel GridLayoutRowSpacingPropertyInfo = "row-spacing"
    type AttrOrigin GridLayoutRowSpacingPropertyInfo = GridLayout
    attrGet = getGridLayoutRowSpacing
    attrSet = setGridLayoutRowSpacing
    attrTransfer _ v = do
        return v
    attrConstruct = constructGridLayoutRowSpacing
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.rowSpacing"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#g:attr:rowSpacing"
        })
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList GridLayout
type instance O.AttributeList GridLayout = GridLayoutAttributeList
type GridLayoutAttributeList = ('[ '("baselineRow", GridLayoutBaselineRowPropertyInfo), '("columnHomogeneous", GridLayoutColumnHomogeneousPropertyInfo), '("columnSpacing", GridLayoutColumnSpacingPropertyInfo), '("rowHomogeneous", GridLayoutRowHomogeneousPropertyInfo), '("rowSpacing", GridLayoutRowSpacingPropertyInfo)] :: [(Symbol, *)])
#endif
#if defined(ENABLE_OVERLOADING)
gridLayoutBaselineRow :: AttrLabelProxy "baselineRow"
gridLayoutBaselineRow = AttrLabelProxy
gridLayoutColumnHomogeneous :: AttrLabelProxy "columnHomogeneous"
gridLayoutColumnHomogeneous = AttrLabelProxy
gridLayoutColumnSpacing :: AttrLabelProxy "columnSpacing"
gridLayoutColumnSpacing = AttrLabelProxy
gridLayoutRowHomogeneous :: AttrLabelProxy "rowHomogeneous"
gridLayoutRowHomogeneous = AttrLabelProxy
gridLayoutRowSpacing :: AttrLabelProxy "rowSpacing"
gridLayoutRowSpacing = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList GridLayout = GridLayoutSignalList
type GridLayoutSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "gtk_grid_layout_new" gtk_grid_layout_new :: 
    IO (Ptr GridLayout)
gridLayoutNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m GridLayout
    
gridLayoutNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m GridLayout
gridLayoutNew  = IO GridLayout -> m GridLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GridLayout -> m GridLayout) -> IO GridLayout -> m GridLayout
forall a b. (a -> b) -> a -> b
$ do
    Ptr GridLayout
result <- IO (Ptr GridLayout)
gtk_grid_layout_new
    Text -> Ptr GridLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"gridLayoutNew" Ptr GridLayout
result
    GridLayout
result' <- ((ManagedPtr GridLayout -> GridLayout)
-> Ptr GridLayout -> IO GridLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr GridLayout -> GridLayout
GridLayout) Ptr GridLayout
result
    GridLayout -> IO GridLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GridLayout
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "gtk_grid_layout_get_baseline_row" gtk_grid_layout_get_baseline_row :: 
    Ptr GridLayout ->                       
    IO Int32
gridLayoutGetBaselineRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> m Int32
    
gridLayoutGetBaselineRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> m Int32
gridLayoutGetBaselineRow a
grid = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    Int32
result <- Ptr GridLayout -> IO Int32
gtk_grid_layout_get_baseline_row Ptr GridLayout
grid'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data GridLayoutGetBaselineRowMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutGetBaselineRowMethodInfo a signature where
    overloadedMethod = gridLayoutGetBaselineRow
instance O.OverloadedMethodInfo GridLayoutGetBaselineRowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutGetBaselineRow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutGetBaselineRow"
        })
#endif
foreign import ccall "gtk_grid_layout_get_column_homogeneous" gtk_grid_layout_get_column_homogeneous :: 
    Ptr GridLayout ->                       
    IO CInt
gridLayoutGetColumnHomogeneous ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> m Bool
    
gridLayoutGetColumnHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> m Bool
gridLayoutGetColumnHomogeneous a
grid = 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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    CInt
result <- Ptr GridLayout -> IO CInt
gtk_grid_layout_get_column_homogeneous Ptr GridLayout
grid'
    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
grid
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data GridLayoutGetColumnHomogeneousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutGetColumnHomogeneousMethodInfo a signature where
    overloadedMethod = gridLayoutGetColumnHomogeneous
instance O.OverloadedMethodInfo GridLayoutGetColumnHomogeneousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutGetColumnHomogeneous",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutGetColumnHomogeneous"
        })
#endif
foreign import ccall "gtk_grid_layout_get_column_spacing" gtk_grid_layout_get_column_spacing :: 
    Ptr GridLayout ->                       
    IO Word32
gridLayoutGetColumnSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> m Word32
    
gridLayoutGetColumnSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> m Word32
gridLayoutGetColumnSpacing a
grid = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    Word32
result <- Ptr GridLayout -> IO Word32
gtk_grid_layout_get_column_spacing Ptr GridLayout
grid'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data GridLayoutGetColumnSpacingMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutGetColumnSpacingMethodInfo a signature where
    overloadedMethod = gridLayoutGetColumnSpacing
instance O.OverloadedMethodInfo GridLayoutGetColumnSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutGetColumnSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutGetColumnSpacing"
        })
#endif
foreign import ccall "gtk_grid_layout_get_row_baseline_position" gtk_grid_layout_get_row_baseline_position :: 
    Ptr GridLayout ->                       
    Int32 ->                                
    IO CUInt
gridLayoutGetRowBaselinePosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Int32
    
    -> m Gtk.Enums.BaselinePosition
    
gridLayoutGetRowBaselinePosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Int32 -> m BaselinePosition
gridLayoutGetRowBaselinePosition a
grid Int32
row = IO BaselinePosition -> m BaselinePosition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaselinePosition -> m BaselinePosition)
-> IO BaselinePosition -> m BaselinePosition
forall a b. (a -> b) -> a -> b
$ do
    Ptr GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    CUInt
result <- Ptr GridLayout -> Int32 -> IO CUInt
gtk_grid_layout_get_row_baseline_position Ptr GridLayout
grid' Int32
row
    let result' :: BaselinePosition
result' = (Int -> BaselinePosition
forall a. Enum a => Int -> a
toEnum (Int -> BaselinePosition)
-> (CUInt -> Int) -> CUInt -> BaselinePosition
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
grid
    BaselinePosition -> IO BaselinePosition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaselinePosition
result'
#if defined(ENABLE_OVERLOADING)
data GridLayoutGetRowBaselinePositionMethodInfo
instance (signature ~ (Int32 -> m Gtk.Enums.BaselinePosition), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutGetRowBaselinePositionMethodInfo a signature where
    overloadedMethod = gridLayoutGetRowBaselinePosition
instance O.OverloadedMethodInfo GridLayoutGetRowBaselinePositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutGetRowBaselinePosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutGetRowBaselinePosition"
        })
#endif
foreign import ccall "gtk_grid_layout_get_row_homogeneous" gtk_grid_layout_get_row_homogeneous :: 
    Ptr GridLayout ->                       
    IO CInt
gridLayoutGetRowHomogeneous ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> m Bool
    
gridLayoutGetRowHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> m Bool
gridLayoutGetRowHomogeneous a
grid = 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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    CInt
result <- Ptr GridLayout -> IO CInt
gtk_grid_layout_get_row_homogeneous Ptr GridLayout
grid'
    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
grid
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data GridLayoutGetRowHomogeneousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutGetRowHomogeneousMethodInfo a signature where
    overloadedMethod = gridLayoutGetRowHomogeneous
instance O.OverloadedMethodInfo GridLayoutGetRowHomogeneousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutGetRowHomogeneous",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutGetRowHomogeneous"
        })
#endif
foreign import ccall "gtk_grid_layout_get_row_spacing" gtk_grid_layout_get_row_spacing :: 
    Ptr GridLayout ->                       
    IO Word32
gridLayoutGetRowSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> m Word32
    
gridLayoutGetRowSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> m Word32
gridLayoutGetRowSpacing a
grid = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    Word32
result <- Ptr GridLayout -> IO Word32
gtk_grid_layout_get_row_spacing Ptr GridLayout
grid'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data GridLayoutGetRowSpacingMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutGetRowSpacingMethodInfo a signature where
    overloadedMethod = gridLayoutGetRowSpacing
instance O.OverloadedMethodInfo GridLayoutGetRowSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutGetRowSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutGetRowSpacing"
        })
#endif
foreign import ccall "gtk_grid_layout_set_baseline_row" gtk_grid_layout_set_baseline_row :: 
    Ptr GridLayout ->                       
    Int32 ->                                
    IO ()
gridLayoutSetBaselineRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Int32
    
    -> m ()
gridLayoutSetBaselineRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Int32 -> m ()
gridLayoutSetBaselineRow a
grid Int32
row = 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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    Ptr GridLayout -> Int32 -> IO ()
gtk_grid_layout_set_baseline_row Ptr GridLayout
grid' Int32
row
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GridLayoutSetBaselineRowMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutSetBaselineRowMethodInfo a signature where
    overloadedMethod = gridLayoutSetBaselineRow
instance O.OverloadedMethodInfo GridLayoutSetBaselineRowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutSetBaselineRow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutSetBaselineRow"
        })
#endif
foreign import ccall "gtk_grid_layout_set_column_homogeneous" gtk_grid_layout_set_column_homogeneous :: 
    Ptr GridLayout ->                       
    CInt ->                                 
    IO ()
gridLayoutSetColumnHomogeneous ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Bool
    
    -> m ()
gridLayoutSetColumnHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Bool -> m ()
gridLayoutSetColumnHomogeneous a
grid 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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    let homogeneous' :: CInt
homogeneous' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
homogeneous
    Ptr GridLayout -> CInt -> IO ()
gtk_grid_layout_set_column_homogeneous Ptr GridLayout
grid' CInt
homogeneous'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GridLayoutSetColumnHomogeneousMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutSetColumnHomogeneousMethodInfo a signature where
    overloadedMethod = gridLayoutSetColumnHomogeneous
instance O.OverloadedMethodInfo GridLayoutSetColumnHomogeneousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutSetColumnHomogeneous",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutSetColumnHomogeneous"
        })
#endif
foreign import ccall "gtk_grid_layout_set_column_spacing" gtk_grid_layout_set_column_spacing :: 
    Ptr GridLayout ->                       
    Word32 ->                               
    IO ()
gridLayoutSetColumnSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Word32
    
    -> m ()
gridLayoutSetColumnSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Word32 -> m ()
gridLayoutSetColumnSpacing a
grid Word32
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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    Ptr GridLayout -> Word32 -> IO ()
gtk_grid_layout_set_column_spacing Ptr GridLayout
grid' Word32
spacing
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GridLayoutSetColumnSpacingMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutSetColumnSpacingMethodInfo a signature where
    overloadedMethod = gridLayoutSetColumnSpacing
instance O.OverloadedMethodInfo GridLayoutSetColumnSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutSetColumnSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutSetColumnSpacing"
        })
#endif
foreign import ccall "gtk_grid_layout_set_row_baseline_position" gtk_grid_layout_set_row_baseline_position :: 
    Ptr GridLayout ->                       
    Int32 ->                                
    CUInt ->                                
    IO ()
gridLayoutSetRowBaselinePosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Int32
    
    -> Gtk.Enums.BaselinePosition
    
    -> m ()
gridLayoutSetRowBaselinePosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Int32 -> BaselinePosition -> m ()
gridLayoutSetRowBaselinePosition a
grid Int32
row BaselinePosition
pos = 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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    let pos' :: CUInt
pos' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (BaselinePosition -> Int) -> BaselinePosition -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaselinePosition -> Int
forall a. Enum a => a -> Int
fromEnum) BaselinePosition
pos
    Ptr GridLayout -> Int32 -> CUInt -> IO ()
gtk_grid_layout_set_row_baseline_position Ptr GridLayout
grid' Int32
row CUInt
pos'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GridLayoutSetRowBaselinePositionMethodInfo
instance (signature ~ (Int32 -> Gtk.Enums.BaselinePosition -> m ()), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutSetRowBaselinePositionMethodInfo a signature where
    overloadedMethod = gridLayoutSetRowBaselinePosition
instance O.OverloadedMethodInfo GridLayoutSetRowBaselinePositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutSetRowBaselinePosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutSetRowBaselinePosition"
        })
#endif
foreign import ccall "gtk_grid_layout_set_row_homogeneous" gtk_grid_layout_set_row_homogeneous :: 
    Ptr GridLayout ->                       
    CInt ->                                 
    IO ()
gridLayoutSetRowHomogeneous ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Bool
    
    -> m ()
gridLayoutSetRowHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Bool -> m ()
gridLayoutSetRowHomogeneous a
grid 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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    let homogeneous' :: CInt
homogeneous' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
homogeneous
    Ptr GridLayout -> CInt -> IO ()
gtk_grid_layout_set_row_homogeneous Ptr GridLayout
grid' CInt
homogeneous'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GridLayoutSetRowHomogeneousMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutSetRowHomogeneousMethodInfo a signature where
    overloadedMethod = gridLayoutSetRowHomogeneous
instance O.OverloadedMethodInfo GridLayoutSetRowHomogeneousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutSetRowHomogeneous",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutSetRowHomogeneous"
        })
#endif
foreign import ccall "gtk_grid_layout_set_row_spacing" gtk_grid_layout_set_row_spacing :: 
    Ptr GridLayout ->                       
    Word32 ->                               
    IO ()
gridLayoutSetRowSpacing ::
    (B.CallStack.HasCallStack, MonadIO m, IsGridLayout a) =>
    a
    
    -> Word32
    
    -> m ()
gridLayoutSetRowSpacing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGridLayout a) =>
a -> Word32 -> m ()
gridLayoutSetRowSpacing a
grid Word32
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 GridLayout
grid' <- a -> IO (Ptr GridLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
grid
    Ptr GridLayout -> Word32 -> IO ()
gtk_grid_layout_set_row_spacing Ptr GridLayout
grid' Word32
spacing
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
grid
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GridLayoutSetRowSpacingMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsGridLayout a) => O.OverloadedMethod GridLayoutSetRowSpacingMethodInfo a signature where
    overloadedMethod = gridLayoutSetRowSpacing
instance O.OverloadedMethodInfo GridLayoutSetRowSpacingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.GridLayout.gridLayoutSetRowSpacing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-GridLayout.html#v:gridLayoutSetRowSpacing"
        })
#endif