{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gtk.Objects.ContainerCellAccessible
    ( 

-- * Exported types
    ContainerCellAccessible(..)             ,
    IsContainerCellAccessible               ,
    toContainerCellAccessible               ,
    noContainerCellAccessible               ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveContainerCellAccessibleMethod    ,
#endif


-- ** addChild #method:addChild#

#if defined(ENABLE_OVERLOADING)
    ContainerCellAccessibleAddChildMethodInfo,
#endif
    containerCellAccessibleAddChild         ,


-- ** getChildren #method:getChildren#

#if defined(ENABLE_OVERLOADING)
    ContainerCellAccessibleGetChildrenMethodInfo,
#endif
    containerCellAccessibleGetChildren      ,


-- ** new #method:new#

    containerCellAccessibleNew              ,


-- ** removeChild #method:removeChild#

#if defined(ENABLE_OVERLOADING)
    ContainerCellAccessibleRemoveChildMethodInfo,
#endif
    containerCellAccessibleRemoveChild      ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 GI.Atk.Interfaces.Action as Atk.Action
import qualified GI.Atk.Interfaces.Component as Atk.Component
import qualified GI.Atk.Interfaces.TableCell as Atk.TableCell
import qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Objects.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellAccessible as Gtk.CellAccessible

-- | Memory-managed wrapper type.
newtype ContainerCellAccessible = ContainerCellAccessible (ManagedPtr ContainerCellAccessible)
    deriving (ContainerCellAccessible -> ContainerCellAccessible -> Bool
(ContainerCellAccessible -> ContainerCellAccessible -> Bool)
-> (ContainerCellAccessible -> ContainerCellAccessible -> Bool)
-> Eq ContainerCellAccessible
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainerCellAccessible -> ContainerCellAccessible -> Bool
$c/= :: ContainerCellAccessible -> ContainerCellAccessible -> Bool
== :: ContainerCellAccessible -> ContainerCellAccessible -> Bool
$c== :: ContainerCellAccessible -> ContainerCellAccessible -> Bool
Eq)
foreign import ccall "gtk_container_cell_accessible_get_type"
    c_gtk_container_cell_accessible_get_type :: IO GType

instance GObject ContainerCellAccessible where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_container_cell_accessible_get_type
    

-- | Convert 'ContainerCellAccessible' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue ContainerCellAccessible where
    toGValue :: ContainerCellAccessible -> IO GValue
toGValue o :: ContainerCellAccessible
o = do
        GType
gtype <- IO GType
c_gtk_container_cell_accessible_get_type
        ContainerCellAccessible
-> (Ptr ContainerCellAccessible -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ContainerCellAccessible
o (GType
-> (GValue -> Ptr ContainerCellAccessible -> IO ())
-> Ptr ContainerCellAccessible
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr ContainerCellAccessible -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO ContainerCellAccessible
fromGValue gv :: GValue
gv = do
        Ptr ContainerCellAccessible
ptr <- GValue -> IO (Ptr ContainerCellAccessible)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr ContainerCellAccessible)
        (ManagedPtr ContainerCellAccessible -> ContainerCellAccessible)
-> Ptr ContainerCellAccessible -> IO ContainerCellAccessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ContainerCellAccessible -> ContainerCellAccessible
ContainerCellAccessible Ptr ContainerCellAccessible
ptr
        
    

-- | Type class for types which can be safely cast to `ContainerCellAccessible`, for instance with `toContainerCellAccessible`.
class (GObject o, O.IsDescendantOf ContainerCellAccessible o) => IsContainerCellAccessible o
instance (GObject o, O.IsDescendantOf ContainerCellAccessible o) => IsContainerCellAccessible o

instance O.HasParentTypes ContainerCellAccessible
type instance O.ParentTypes ContainerCellAccessible = '[Gtk.CellAccessible.CellAccessible, Gtk.Accessible.Accessible, Atk.Object.Object, GObject.Object.Object, Atk.Action.Action, Atk.Component.Component, Atk.TableCell.TableCell]

-- | Cast to `ContainerCellAccessible`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toContainerCellAccessible :: (MonadIO m, IsContainerCellAccessible o) => o -> m ContainerCellAccessible
toContainerCellAccessible :: o -> m ContainerCellAccessible
toContainerCellAccessible = IO ContainerCellAccessible -> m ContainerCellAccessible
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContainerCellAccessible -> m ContainerCellAccessible)
-> (o -> IO ContainerCellAccessible)
-> o
-> m ContainerCellAccessible
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ContainerCellAccessible -> ContainerCellAccessible)
-> o -> IO ContainerCellAccessible
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr ContainerCellAccessible -> ContainerCellAccessible
ContainerCellAccessible

-- | A convenience alias for `Nothing` :: `Maybe` `ContainerCellAccessible`.
noContainerCellAccessible :: Maybe ContainerCellAccessible
noContainerCellAccessible :: Maybe ContainerCellAccessible
noContainerCellAccessible = Maybe ContainerCellAccessible
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveContainerCellAccessibleMethod (t :: Symbol) (o :: *) :: * where
    ResolveContainerCellAccessibleMethod "addChild" o = ContainerCellAccessibleAddChildMethodInfo
    ResolveContainerCellAccessibleMethod "addRelationship" o = Atk.Object.ObjectAddRelationshipMethodInfo
    ResolveContainerCellAccessibleMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContainerCellAccessibleMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContainerCellAccessibleMethod "connectWidgetDestroyed" o = Gtk.Accessible.AccessibleConnectWidgetDestroyedMethodInfo
    ResolveContainerCellAccessibleMethod "contains" o = Atk.Component.ComponentContainsMethodInfo
    ResolveContainerCellAccessibleMethod "doAction" o = Atk.Action.ActionDoActionMethodInfo
    ResolveContainerCellAccessibleMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContainerCellAccessibleMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContainerCellAccessibleMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContainerCellAccessibleMethod "grabFocus" o = Atk.Component.ComponentGrabFocusMethodInfo
    ResolveContainerCellAccessibleMethod "initialize" o = Atk.Object.ObjectInitializeMethodInfo
    ResolveContainerCellAccessibleMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContainerCellAccessibleMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContainerCellAccessibleMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContainerCellAccessibleMethod "notifyStateChange" o = Atk.Object.ObjectNotifyStateChangeMethodInfo
    ResolveContainerCellAccessibleMethod "peekParent" o = Atk.Object.ObjectPeekParentMethodInfo
    ResolveContainerCellAccessibleMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContainerCellAccessibleMethod "refAccessibleAtPoint" o = Atk.Component.ComponentRefAccessibleAtPointMethodInfo
    ResolveContainerCellAccessibleMethod "refAccessibleChild" o = Atk.Object.ObjectRefAccessibleChildMethodInfo
    ResolveContainerCellAccessibleMethod "refRelationSet" o = Atk.Object.ObjectRefRelationSetMethodInfo
    ResolveContainerCellAccessibleMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContainerCellAccessibleMethod "refStateSet" o = Atk.Object.ObjectRefStateSetMethodInfo
    ResolveContainerCellAccessibleMethod "removeChild" o = ContainerCellAccessibleRemoveChildMethodInfo
    ResolveContainerCellAccessibleMethod "removeFocusHandler" o = Atk.Component.ComponentRemoveFocusHandlerMethodInfo
    ResolveContainerCellAccessibleMethod "removePropertyChangeHandler" o = Atk.Object.ObjectRemovePropertyChangeHandlerMethodInfo
    ResolveContainerCellAccessibleMethod "removeRelationship" o = Atk.Object.ObjectRemoveRelationshipMethodInfo
    ResolveContainerCellAccessibleMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContainerCellAccessibleMethod "scrollTo" o = Atk.Component.ComponentScrollToMethodInfo
    ResolveContainerCellAccessibleMethod "scrollToPoint" o = Atk.Component.ComponentScrollToPointMethodInfo
    ResolveContainerCellAccessibleMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContainerCellAccessibleMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContainerCellAccessibleMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContainerCellAccessibleMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContainerCellAccessibleMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContainerCellAccessibleMethod "getAlpha" o = Atk.Component.ComponentGetAlphaMethodInfo
    ResolveContainerCellAccessibleMethod "getAttributes" o = Atk.Object.ObjectGetAttributesMethodInfo
    ResolveContainerCellAccessibleMethod "getChildren" o = ContainerCellAccessibleGetChildrenMethodInfo
    ResolveContainerCellAccessibleMethod "getColumnHeaderCells" o = Atk.TableCell.TableCellGetColumnHeaderCellsMethodInfo
    ResolveContainerCellAccessibleMethod "getColumnSpan" o = Atk.TableCell.TableCellGetColumnSpanMethodInfo
    ResolveContainerCellAccessibleMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContainerCellAccessibleMethod "getDescription" o = Atk.Object.ObjectGetDescriptionMethodInfo
    ResolveContainerCellAccessibleMethod "getExtents" o = Atk.Component.ComponentGetExtentsMethodInfo
    ResolveContainerCellAccessibleMethod "getIndexInParent" o = Atk.Object.ObjectGetIndexInParentMethodInfo
    ResolveContainerCellAccessibleMethod "getKeybinding" o = Atk.Action.ActionGetKeybindingMethodInfo
    ResolveContainerCellAccessibleMethod "getLayer" o = Atk.Object.ObjectGetLayerMethodInfo
    ResolveContainerCellAccessibleMethod "getLocalizedName" o = Atk.Action.ActionGetLocalizedNameMethodInfo
    ResolveContainerCellAccessibleMethod "getMdiZorder" o = Atk.Object.ObjectGetMdiZorderMethodInfo
    ResolveContainerCellAccessibleMethod "getNAccessibleChildren" o = Atk.Object.ObjectGetNAccessibleChildrenMethodInfo
    ResolveContainerCellAccessibleMethod "getNActions" o = Atk.Action.ActionGetNActionsMethodInfo
    ResolveContainerCellAccessibleMethod "getName" o = Atk.Object.ObjectGetNameMethodInfo
    ResolveContainerCellAccessibleMethod "getObjectLocale" o = Atk.Object.ObjectGetObjectLocaleMethodInfo
    ResolveContainerCellAccessibleMethod "getParent" o = Atk.Object.ObjectGetParentMethodInfo
    ResolveContainerCellAccessibleMethod "getPosition" o = Atk.Component.ComponentGetPositionMethodInfo
    ResolveContainerCellAccessibleMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContainerCellAccessibleMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContainerCellAccessibleMethod "getRole" o = Atk.Object.ObjectGetRoleMethodInfo
    ResolveContainerCellAccessibleMethod "getRowColumnSpan" o = Atk.TableCell.TableCellGetRowColumnSpanMethodInfo
    ResolveContainerCellAccessibleMethod "getRowHeaderCells" o = Atk.TableCell.TableCellGetRowHeaderCellsMethodInfo
    ResolveContainerCellAccessibleMethod "getRowSpan" o = Atk.TableCell.TableCellGetRowSpanMethodInfo
    ResolveContainerCellAccessibleMethod "getSize" o = Atk.Component.ComponentGetSizeMethodInfo
    ResolveContainerCellAccessibleMethod "getTable" o = Atk.TableCell.TableCellGetTableMethodInfo
    ResolveContainerCellAccessibleMethod "getWidget" o = Gtk.Accessible.AccessibleGetWidgetMethodInfo
    ResolveContainerCellAccessibleMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContainerCellAccessibleMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContainerCellAccessibleMethod "setDescription" o = Atk.Object.ObjectSetDescriptionMethodInfo
    ResolveContainerCellAccessibleMethod "setExtents" o = Atk.Component.ComponentSetExtentsMethodInfo
    ResolveContainerCellAccessibleMethod "setName" o = Atk.Object.ObjectSetNameMethodInfo
    ResolveContainerCellAccessibleMethod "setParent" o = Atk.Object.ObjectSetParentMethodInfo
    ResolveContainerCellAccessibleMethod "setPosition" o = Atk.Component.ComponentSetPositionMethodInfo
    ResolveContainerCellAccessibleMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContainerCellAccessibleMethod "setRole" o = Atk.Object.ObjectSetRoleMethodInfo
    ResolveContainerCellAccessibleMethod "setSize" o = Atk.Component.ComponentSetSizeMethodInfo
    ResolveContainerCellAccessibleMethod "setWidget" o = Gtk.Accessible.AccessibleSetWidgetMethodInfo
    ResolveContainerCellAccessibleMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveContainerCellAccessibleMethod t ContainerCellAccessible, O.MethodInfo info ContainerCellAccessible p) => OL.IsLabel t (ContainerCellAccessible -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ContainerCellAccessible
type instance O.AttributeList ContainerCellAccessible = ContainerCellAccessibleAttributeList
type ContainerCellAccessibleAttributeList = ('[ '("accessibleComponentLayer", Atk.Object.ObjectAccessibleComponentLayerPropertyInfo), '("accessibleComponentMdiZorder", Atk.Object.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessibleDescription", Atk.Object.ObjectAccessibleDescriptionPropertyInfo), '("accessibleHypertextNlinks", Atk.Object.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessibleName", Atk.Object.ObjectAccessibleNamePropertyInfo), '("accessibleParent", Atk.Object.ObjectAccessibleParentPropertyInfo), '("accessibleRole", Atk.Object.ObjectAccessibleRolePropertyInfo), '("accessibleTableCaption", Atk.Object.ObjectAccessibleTableCaptionPropertyInfo), '("accessibleTableCaptionObject", Atk.Object.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessibleTableColumnDescription", Atk.Object.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessibleTableColumnHeader", Atk.Object.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessibleTableRowDescription", Atk.Object.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessibleTableRowHeader", Atk.Object.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessibleTableSummary", Atk.Object.ObjectAccessibleTableSummaryPropertyInfo), '("accessibleValue", Atk.Object.ObjectAccessibleValuePropertyInfo), '("widget", Gtk.Accessible.AccessibleWidgetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ContainerCellAccessible = ContainerCellAccessibleSignalList
type ContainerCellAccessibleSignalList = ('[ '("activeDescendantChanged", Atk.Object.ObjectActiveDescendantChangedSignalInfo), '("boundsChanged", Atk.Component.ComponentBoundsChangedSignalInfo), '("childrenChanged", Atk.Object.ObjectChildrenChangedSignalInfo), '("focusEvent", Atk.Object.ObjectFocusEventSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("propertyChange", Atk.Object.ObjectPropertyChangeSignalInfo), '("stateChange", Atk.Object.ObjectStateChangeSignalInfo), '("visibleDataChanged", Atk.Object.ObjectVisibleDataChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method ContainerCellAccessible::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gtk" , name = "ContainerCellAccessible" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_cell_accessible_new" gtk_container_cell_accessible_new :: 
    IO (Ptr ContainerCellAccessible)

-- | /No description available in the introspection data./
containerCellAccessibleNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ContainerCellAccessible
containerCellAccessibleNew :: m ContainerCellAccessible
containerCellAccessibleNew  = IO ContainerCellAccessible -> m ContainerCellAccessible
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContainerCellAccessible -> m ContainerCellAccessible)
-> IO ContainerCellAccessible -> m ContainerCellAccessible
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContainerCellAccessible
result <- IO (Ptr ContainerCellAccessible)
gtk_container_cell_accessible_new
    Text -> Ptr ContainerCellAccessible -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "containerCellAccessibleNew" Ptr ContainerCellAccessible
result
    ContainerCellAccessible
result' <- ((ManagedPtr ContainerCellAccessible -> ContainerCellAccessible)
-> Ptr ContainerCellAccessible -> IO ContainerCellAccessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ContainerCellAccessible -> ContainerCellAccessible
ContainerCellAccessible) Ptr ContainerCellAccessible
result
    ContainerCellAccessible -> IO ContainerCellAccessible
forall (m :: * -> *) a. Monad m => a -> m a
return ContainerCellAccessible
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContainerCellAccessible::add_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "ContainerCellAccessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CellAccessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_cell_accessible_add_child" gtk_container_cell_accessible_add_child :: 
    Ptr ContainerCellAccessible ->          -- container : TInterface (Name {namespace = "Gtk", name = "ContainerCellAccessible"})
    Ptr Gtk.CellAccessible.CellAccessible -> -- child : TInterface (Name {namespace = "Gtk", name = "CellAccessible"})
    IO ()

-- | /No description available in the introspection data./
containerCellAccessibleAddChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainerCellAccessible a, Gtk.CellAccessible.IsCellAccessible b) =>
    a
    -> b
    -> m ()
containerCellAccessibleAddChild :: a -> b -> m ()
containerCellAccessibleAddChild container :: a
container child :: b
child = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContainerCellAccessible
container' <- a -> IO (Ptr ContainerCellAccessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr CellAccessible
child' <- b -> IO (Ptr CellAccessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr ContainerCellAccessible -> Ptr CellAccessible -> IO ()
gtk_container_cell_accessible_add_child Ptr ContainerCellAccessible
container' Ptr CellAccessible
child'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerCellAccessibleAddChildMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainerCellAccessible a, Gtk.CellAccessible.IsCellAccessible b) => O.MethodInfo ContainerCellAccessibleAddChildMethodInfo a signature where
    overloadedMethod = containerCellAccessibleAddChild

#endif

-- method ContainerCellAccessible::get_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "ContainerCellAccessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the container" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gtk" , name = "CellAccessible" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_cell_accessible_get_children" gtk_container_cell_accessible_get_children :: 
    Ptr ContainerCellAccessible ->          -- container : TInterface (Name {namespace = "Gtk", name = "ContainerCellAccessible"})
    IO (Ptr (GList (Ptr Gtk.CellAccessible.CellAccessible)))

-- | Get a list of children.
containerCellAccessibleGetChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainerCellAccessible a) =>
    a
    -- ^ /@container@/: the container
    -> m [Gtk.CellAccessible.CellAccessible]
containerCellAccessibleGetChildren :: a -> m [CellAccessible]
containerCellAccessibleGetChildren container :: a
container = IO [CellAccessible] -> m [CellAccessible]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CellAccessible] -> m [CellAccessible])
-> IO [CellAccessible] -> m [CellAccessible]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContainerCellAccessible
container' <- a -> IO (Ptr ContainerCellAccessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr (GList (Ptr CellAccessible))
result <- Ptr ContainerCellAccessible
-> IO (Ptr (GList (Ptr CellAccessible)))
gtk_container_cell_accessible_get_children Ptr ContainerCellAccessible
container'
    [Ptr CellAccessible]
result' <- Ptr (GList (Ptr CellAccessible)) -> IO [Ptr CellAccessible]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr CellAccessible))
result
    [CellAccessible]
result'' <- (Ptr CellAccessible -> IO CellAccessible)
-> [Ptr CellAccessible] -> IO [CellAccessible]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr CellAccessible -> CellAccessible)
-> Ptr CellAccessible -> IO CellAccessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr CellAccessible -> CellAccessible
Gtk.CellAccessible.CellAccessible) [Ptr CellAccessible]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    [CellAccessible] -> IO [CellAccessible]
forall (m :: * -> *) a. Monad m => a -> m a
return [CellAccessible]
result''

#if defined(ENABLE_OVERLOADING)
data ContainerCellAccessibleGetChildrenMethodInfo
instance (signature ~ (m [Gtk.CellAccessible.CellAccessible]), MonadIO m, IsContainerCellAccessible a) => O.MethodInfo ContainerCellAccessibleGetChildrenMethodInfo a signature where
    overloadedMethod = containerCellAccessibleGetChildren

#endif

-- method ContainerCellAccessible::remove_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "ContainerCellAccessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "CellAccessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_container_cell_accessible_remove_child" gtk_container_cell_accessible_remove_child :: 
    Ptr ContainerCellAccessible ->          -- container : TInterface (Name {namespace = "Gtk", name = "ContainerCellAccessible"})
    Ptr Gtk.CellAccessible.CellAccessible -> -- child : TInterface (Name {namespace = "Gtk", name = "CellAccessible"})
    IO ()

-- | /No description available in the introspection data./
containerCellAccessibleRemoveChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainerCellAccessible a, Gtk.CellAccessible.IsCellAccessible b) =>
    a
    -> b
    -> m ()
containerCellAccessibleRemoveChild :: a -> b -> m ()
containerCellAccessibleRemoveChild container :: a
container child :: b
child = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContainerCellAccessible
container' <- a -> IO (Ptr ContainerCellAccessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr CellAccessible
child' <- b -> IO (Ptr CellAccessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr ContainerCellAccessible -> Ptr CellAccessible -> IO ()
gtk_container_cell_accessible_remove_child Ptr ContainerCellAccessible
container' Ptr CellAccessible
child'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerCellAccessibleRemoveChildMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainerCellAccessible a, Gtk.CellAccessible.IsCellAccessible b) => O.MethodInfo ContainerCellAccessibleRemoveChildMethodInfo a signature where
    overloadedMethod = containerCellAccessibleRemoveChild

#endif