{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.LayoutChild
(
LayoutChild(..) ,
IsLayoutChild ,
toLayoutChild ,
#if defined(ENABLE_OVERLOADING)
ResolveLayoutChildMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
LayoutChildGetChildWidgetMethodInfo ,
#endif
layoutChildGetChildWidget ,
#if defined(ENABLE_OVERLOADING)
LayoutChildGetLayoutManagerMethodInfo ,
#endif
layoutChildGetLayoutManager ,
#if defined(ENABLE_OVERLOADING)
LayoutChildChildWidgetPropertyInfo ,
#endif
constructLayoutChildChildWidget ,
getLayoutChildChildWidget ,
#if defined(ENABLE_OVERLOADING)
layoutChildChildWidget ,
#endif
#if defined(ENABLE_OVERLOADING)
LayoutChildLayoutManagerPropertyInfo ,
#endif
constructLayoutChildLayoutManager ,
getLayoutChildLayoutManager ,
#if defined(ENABLE_OVERLOADING)
layoutChildLayoutManager ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
newtype LayoutChild = LayoutChild (SP.ManagedPtr LayoutChild)
deriving (LayoutChild -> LayoutChild -> Bool
(LayoutChild -> LayoutChild -> Bool)
-> (LayoutChild -> LayoutChild -> Bool) -> Eq LayoutChild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutChild -> LayoutChild -> Bool
$c/= :: LayoutChild -> LayoutChild -> Bool
== :: LayoutChild -> LayoutChild -> Bool
$c== :: LayoutChild -> LayoutChild -> Bool
Eq)
instance SP.ManagedPtrNewtype LayoutChild where
toManagedPtr :: LayoutChild -> ManagedPtr LayoutChild
toManagedPtr (LayoutChild ManagedPtr LayoutChild
p) = ManagedPtr LayoutChild
p
foreign import ccall "gtk_layout_child_get_type"
c_gtk_layout_child_get_type :: IO B.Types.GType
instance B.Types.TypedObject LayoutChild where
glibType :: IO GType
glibType = IO GType
c_gtk_layout_child_get_type
instance B.Types.GObject LayoutChild
class (SP.GObject o, O.IsDescendantOf LayoutChild o) => IsLayoutChild o
instance (SP.GObject o, O.IsDescendantOf LayoutChild o) => IsLayoutChild o
instance O.HasParentTypes LayoutChild
type instance O.ParentTypes LayoutChild = '[GObject.Object.Object]
toLayoutChild :: (MIO.MonadIO m, IsLayoutChild o) => o -> m LayoutChild
toLayoutChild :: forall (m :: * -> *) o.
(MonadIO m, IsLayoutChild o) =>
o -> m LayoutChild
toLayoutChild = IO LayoutChild -> m LayoutChild
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO LayoutChild -> m LayoutChild)
-> (o -> IO LayoutChild) -> o -> m LayoutChild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr LayoutChild -> LayoutChild) -> o -> IO LayoutChild
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr LayoutChild -> LayoutChild
LayoutChild
instance B.GValue.IsGValue (Maybe LayoutChild) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_layout_child_get_type
gvalueSet_ :: Ptr GValue -> Maybe LayoutChild -> IO ()
gvalueSet_ Ptr GValue
gv Maybe LayoutChild
P.Nothing = Ptr GValue -> Ptr LayoutChild -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr LayoutChild
forall a. Ptr a
FP.nullPtr :: FP.Ptr LayoutChild)
gvalueSet_ Ptr GValue
gv (P.Just LayoutChild
obj) = LayoutChild -> (Ptr LayoutChild -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr LayoutChild
obj (Ptr GValue -> Ptr LayoutChild -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe LayoutChild)
gvalueGet_ Ptr GValue
gv = do
Ptr LayoutChild
ptr <- Ptr GValue -> IO (Ptr LayoutChild)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr LayoutChild)
if Ptr LayoutChild
ptr Ptr LayoutChild -> Ptr LayoutChild -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr LayoutChild
forall a. Ptr a
FP.nullPtr
then LayoutChild -> Maybe LayoutChild
forall a. a -> Maybe a
P.Just (LayoutChild -> Maybe LayoutChild)
-> IO LayoutChild -> IO (Maybe LayoutChild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr LayoutChild -> LayoutChild)
-> Ptr LayoutChild -> IO LayoutChild
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr LayoutChild -> LayoutChild
LayoutChild Ptr LayoutChild
ptr
else Maybe LayoutChild -> IO (Maybe LayoutChild)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LayoutChild
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveLayoutChildMethod (t :: Symbol) (o :: *) :: * where
ResolveLayoutChildMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveLayoutChildMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveLayoutChildMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveLayoutChildMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveLayoutChildMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveLayoutChildMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveLayoutChildMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveLayoutChildMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveLayoutChildMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveLayoutChildMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveLayoutChildMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveLayoutChildMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveLayoutChildMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveLayoutChildMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveLayoutChildMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveLayoutChildMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveLayoutChildMethod "getChildWidget" o = LayoutChildGetChildWidgetMethodInfo
ResolveLayoutChildMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveLayoutChildMethod "getLayoutManager" o = LayoutChildGetLayoutManagerMethodInfo
ResolveLayoutChildMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveLayoutChildMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveLayoutChildMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveLayoutChildMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveLayoutChildMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveLayoutChildMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveLayoutChildMethod t LayoutChild, O.OverloadedMethod info LayoutChild p) => OL.IsLabel t (LayoutChild -> 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 ~ ResolveLayoutChildMethod t LayoutChild, O.OverloadedMethod info LayoutChild p, R.HasField t LayoutChild p) => R.HasField t LayoutChild p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveLayoutChildMethod t LayoutChild, O.OverloadedMethodInfo info LayoutChild) => OL.IsLabel t (O.MethodProxy info LayoutChild) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getLayoutChildChildWidget :: (MonadIO m, IsLayoutChild o) => o -> m Gtk.Widget.Widget
getLayoutChildChildWidget :: forall (m :: * -> *) o.
(MonadIO m, IsLayoutChild o) =>
o -> m Widget
getLayoutChildChildWidget o
obj = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Widget) -> IO Widget
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getLayoutChildChildWidget" (IO (Maybe Widget) -> IO Widget) -> IO (Maybe Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Widget -> Widget) -> IO (Maybe Widget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"child-widget" ManagedPtr Widget -> Widget
Gtk.Widget.Widget
constructLayoutChildChildWidget :: (IsLayoutChild o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructLayoutChildChildWidget :: forall o (m :: * -> *) a.
(IsLayoutChild o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructLayoutChildChildWidget a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"child-widget" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data LayoutChildChildWidgetPropertyInfo
instance AttrInfo LayoutChildChildWidgetPropertyInfo where
type AttrAllowedOps LayoutChildChildWidgetPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint LayoutChildChildWidgetPropertyInfo = IsLayoutChild
type AttrSetTypeConstraint LayoutChildChildWidgetPropertyInfo = Gtk.Widget.IsWidget
type AttrTransferTypeConstraint LayoutChildChildWidgetPropertyInfo = Gtk.Widget.IsWidget
type AttrTransferType LayoutChildChildWidgetPropertyInfo = Gtk.Widget.Widget
type AttrGetType LayoutChildChildWidgetPropertyInfo = Gtk.Widget.Widget
type AttrLabel LayoutChildChildWidgetPropertyInfo = "child-widget"
type AttrOrigin LayoutChildChildWidgetPropertyInfo = LayoutChild
attrGet = getLayoutChildChildWidget
attrSet = undefined
attrTransfer _ v = do
unsafeCastTo Gtk.Widget.Widget v
attrConstruct = constructLayoutChildChildWidget
attrClear = undefined
#endif
getLayoutChildLayoutManager :: (MonadIO m, IsLayoutChild o) => o -> m Gtk.LayoutManager.LayoutManager
getLayoutChildLayoutManager :: forall (m :: * -> *) o.
(MonadIO m, IsLayoutChild o) =>
o -> m LayoutManager
getLayoutChildLayoutManager o
obj = IO LayoutManager -> m LayoutManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO LayoutManager -> m LayoutManager)
-> IO LayoutManager -> m LayoutManager
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe LayoutManager) -> IO LayoutManager
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getLayoutChildLayoutManager" (IO (Maybe LayoutManager) -> IO LayoutManager)
-> IO (Maybe LayoutManager) -> IO LayoutManager
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr LayoutManager -> LayoutManager)
-> IO (Maybe LayoutManager)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"layout-manager" ManagedPtr LayoutManager -> LayoutManager
Gtk.LayoutManager.LayoutManager
constructLayoutChildLayoutManager :: (IsLayoutChild o, MIO.MonadIO m, Gtk.LayoutManager.IsLayoutManager a) => a -> m (GValueConstruct o)
constructLayoutChildLayoutManager :: forall o (m :: * -> *) a.
(IsLayoutChild o, MonadIO m, IsLayoutManager a) =>
a -> m (GValueConstruct o)
constructLayoutChildLayoutManager a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"layout-manager" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data LayoutChildLayoutManagerPropertyInfo
instance AttrInfo LayoutChildLayoutManagerPropertyInfo where
type AttrAllowedOps LayoutChildLayoutManagerPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint LayoutChildLayoutManagerPropertyInfo = IsLayoutChild
type AttrSetTypeConstraint LayoutChildLayoutManagerPropertyInfo = Gtk.LayoutManager.IsLayoutManager
type AttrTransferTypeConstraint LayoutChildLayoutManagerPropertyInfo = Gtk.LayoutManager.IsLayoutManager
type AttrTransferType LayoutChildLayoutManagerPropertyInfo = Gtk.LayoutManager.LayoutManager
type AttrGetType LayoutChildLayoutManagerPropertyInfo = Gtk.LayoutManager.LayoutManager
type AttrLabel LayoutChildLayoutManagerPropertyInfo = "layout-manager"
type AttrOrigin LayoutChildLayoutManagerPropertyInfo = LayoutChild
attrGet = getLayoutChildLayoutManager
attrSet = undefined
attrTransfer _ v = do
unsafeCastTo Gtk.LayoutManager.LayoutManager v
attrConstruct = constructLayoutChildLayoutManager
attrClear = undefined
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList LayoutChild
type instance O.AttributeList LayoutChild = LayoutChildAttributeList
type LayoutChildAttributeList = ('[ '("childWidget", LayoutChildChildWidgetPropertyInfo), '("layoutManager", LayoutChildLayoutManagerPropertyInfo)] :: [(Symbol, *)])
#endif
#if defined(ENABLE_OVERLOADING)
layoutChildChildWidget :: AttrLabelProxy "childWidget"
layoutChildChildWidget = AttrLabelProxy
layoutChildLayoutManager :: AttrLabelProxy "layoutManager"
layoutChildLayoutManager = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList LayoutChild = LayoutChildSignalList
type LayoutChildSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "gtk_layout_child_get_child_widget" gtk_layout_child_get_child_widget ::
Ptr LayoutChild ->
IO (Ptr Gtk.Widget.Widget)
layoutChildGetChildWidget ::
(B.CallStack.HasCallStack, MonadIO m, IsLayoutChild a) =>
a
-> m Gtk.Widget.Widget
layoutChildGetChildWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutChild a) =>
a -> m Widget
layoutChildGetChildWidget a
layoutChild = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
Ptr LayoutChild
layoutChild' <- a -> IO (Ptr LayoutChild)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layoutChild
Ptr Widget
result <- Ptr LayoutChild -> IO (Ptr Widget)
gtk_layout_child_get_child_widget Ptr LayoutChild
layoutChild'
Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutChildGetChildWidget" Ptr Widget
result
Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layoutChild
Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'
#if defined(ENABLE_OVERLOADING)
data LayoutChildGetChildWidgetMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsLayoutChild a) => O.OverloadedMethod LayoutChildGetChildWidgetMethodInfo a signature where
overloadedMethod = layoutChildGetChildWidget
instance O.OverloadedMethodInfo LayoutChildGetChildWidgetMethodInfo a where
overloadedMethodInfo = O.MethodInfo {
O.overloadedMethodName = "GI.Gtk.Objects.LayoutChild.layoutChildGetChildWidget",
O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-LayoutChild.html#v:layoutChildGetChildWidget"
}
#endif
foreign import ccall "gtk_layout_child_get_layout_manager" gtk_layout_child_get_layout_manager ::
Ptr LayoutChild ->
IO (Ptr Gtk.LayoutManager.LayoutManager)
layoutChildGetLayoutManager ::
(B.CallStack.HasCallStack, MonadIO m, IsLayoutChild a) =>
a
-> m Gtk.LayoutManager.LayoutManager
layoutChildGetLayoutManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayoutChild a) =>
a -> m LayoutManager
layoutChildGetLayoutManager a
layoutChild = IO LayoutManager -> m LayoutManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LayoutManager -> m LayoutManager)
-> IO LayoutManager -> m LayoutManager
forall a b. (a -> b) -> a -> b
$ do
Ptr LayoutChild
layoutChild' <- a -> IO (Ptr LayoutChild)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layoutChild
Ptr LayoutManager
result <- Ptr LayoutChild -> IO (Ptr LayoutManager)
gtk_layout_child_get_layout_manager Ptr LayoutChild
layoutChild'
Text -> Ptr LayoutManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutChildGetLayoutManager" Ptr LayoutManager
result
LayoutManager
result' <- ((ManagedPtr LayoutManager -> LayoutManager)
-> Ptr LayoutManager -> IO LayoutManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr LayoutManager -> LayoutManager
Gtk.LayoutManager.LayoutManager) Ptr LayoutManager
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layoutChild
LayoutManager -> IO LayoutManager
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutManager
result'
#if defined(ENABLE_OVERLOADING)
data LayoutChildGetLayoutManagerMethodInfo
instance (signature ~ (m Gtk.LayoutManager.LayoutManager), MonadIO m, IsLayoutChild a) => O.OverloadedMethod LayoutChildGetLayoutManagerMethodInfo a signature where
overloadedMethod = layoutChildGetLayoutManager
instance O.OverloadedMethodInfo LayoutChildGetLayoutManagerMethodInfo a where
overloadedMethodInfo = O.MethodInfo {
O.overloadedMethodName = "GI.Gtk.Objects.LayoutChild.layoutChildGetLayoutManager",
O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-LayoutChild.html#v:layoutChildGetLayoutManager"
}
#endif