{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkAccessible@ is an interface for describing UI elements for
-- Assistive Technologies.
-- 
-- Every accessible implementation has:
-- 
--  - a “role”, represented by a value of the t'GI.Gtk.Enums.AccessibleRole' enumeration
--  - an “attribute”, represented by a set of t'GI.Gtk.Enums.AccessibleState',
--    t'GI.Gtk.Enums.AccessibleProperty' and t'GI.Gtk.Enums.AccessibleRelation' values
-- 
-- The role cannot be changed after instantiating a @GtkAccessible@
-- implementation.
-- 
-- The attributes are updated every time a UI element\'s state changes in
-- a way that should be reflected by assistive technologies. For instance,
-- if a @GtkWidget@ visibility changes, the 'GI.Gtk.Enums.AccessibleStateHidden'
-- state will also change to reflect the [Widget:visible]("GI.Gtk.Objects.Widget#g:attr:visible") property.
-- 
-- Every accessible implementation is part of a tree of accessible objects.
-- Normally, this tree corresponds to the widget tree, but can be customized
-- by reimplementing the t'GI.Gtk.Interfaces.Accessible.Accessible'.@/get_accessible_parent/@(),
-- t'GI.Gtk.Interfaces.Accessible.Accessible'.@/get_first_accessible_child/@() and
-- t'GI.Gtk.Interfaces.Accessible.Accessible'.@/get_next_accessible_sibling/@() virtual functions.
-- Note that you can not create a top-level accessible object as of now,
-- which means that you must always have a parent accessible object.
-- Also note that when an accessible object does not correspond to a widget,
-- and it has children, whose implementation you don\'t control,
-- it is necessary to ensure the correct shape of the a11y tree
-- by calling 'GI.Gtk.Interfaces.Accessible.accessibleSetAccessibleParent' and
-- updating the sibling by 'GI.Gtk.Interfaces.Accessible.accessibleUpdateNextAccessibleSibling'.

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

module GI.Gtk.Interfaces.Accessible
    ( 

-- * Exported types
    Accessible(..)                          ,
    IsAccessible                            ,
    toAccessible                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [updateNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:updateNextAccessibleSibling"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleParent"), [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveAccessibleMethod                 ,
#endif

-- ** getAccessibleParent #method:getAccessibleParent#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetAccessibleParentMethodInfo ,
#endif
    accessibleGetAccessibleParent           ,


-- ** getAccessibleRole #method:getAccessibleRole#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetAccessibleRoleMethodInfo   ,
#endif
    accessibleGetAccessibleRole             ,


-- ** getAtContext #method:getAtContext#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetAtContextMethodInfo        ,
#endif
    accessibleGetAtContext                  ,


-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetBoundsMethodInfo           ,
#endif
    accessibleGetBounds                     ,


-- ** getFirstAccessibleChild #method:getFirstAccessibleChild#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetFirstAccessibleChildMethodInfo,
#endif
    accessibleGetFirstAccessibleChild       ,


-- ** getNextAccessibleSibling #method:getNextAccessibleSibling#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetNextAccessibleSiblingMethodInfo,
#endif
    accessibleGetNextAccessibleSibling      ,


-- ** getPlatformState #method:getPlatformState#

#if defined(ENABLE_OVERLOADING)
    AccessibleGetPlatformStateMethodInfo    ,
#endif
    accessibleGetPlatformState              ,


-- ** resetProperty #method:resetProperty#

#if defined(ENABLE_OVERLOADING)
    AccessibleResetPropertyMethodInfo       ,
#endif
    accessibleResetProperty                 ,


-- ** resetRelation #method:resetRelation#

#if defined(ENABLE_OVERLOADING)
    AccessibleResetRelationMethodInfo       ,
#endif
    accessibleResetRelation                 ,


-- ** resetState #method:resetState#

#if defined(ENABLE_OVERLOADING)
    AccessibleResetStateMethodInfo          ,
#endif
    accessibleResetState                    ,


-- ** setAccessibleParent #method:setAccessibleParent#

#if defined(ENABLE_OVERLOADING)
    AccessibleSetAccessibleParentMethodInfo ,
#endif
    accessibleSetAccessibleParent           ,


-- ** updateNextAccessibleSibling #method:updateNextAccessibleSibling#

#if defined(ENABLE_OVERLOADING)
    AccessibleUpdateNextAccessibleSiblingMethodInfo,
#endif
    accessibleUpdateNextAccessibleSibling   ,


-- ** updateProperty #method:updateProperty#

#if defined(ENABLE_OVERLOADING)
    AccessibleUpdatePropertyMethodInfo      ,
#endif
    accessibleUpdateProperty                ,


-- ** updateRelation #method:updateRelation#

#if defined(ENABLE_OVERLOADING)
    AccessibleUpdateRelationMethodInfo      ,
#endif
    accessibleUpdateRelation                ,


-- ** updateState #method:updateState#

#if defined(ENABLE_OVERLOADING)
    AccessibleUpdateStateMethodInfo         ,
#endif
    accessibleUpdateState                   ,




 -- * Properties


-- ** accessibleRole #attr:accessibleRole#
-- | The accessible role of the given @GtkAccessible@ implementation.
-- 
-- The accessible role cannot be changed once set.

#if defined(ENABLE_OVERLOADING)
    AccessibleAccessibleRolePropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    accessibleAccessibleRole                ,
#endif
    constructAccessibleAccessibleRole       ,
    getAccessibleAccessibleRole             ,
    setAccessibleAccessibleRole             ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext

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

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

foreign import ccall "gtk_accessible_get_type"
    c_gtk_accessible_get_type :: IO B.Types.GType

instance B.Types.TypedObject Accessible where
    glibType :: IO GType
glibType = IO GType
c_gtk_accessible_get_type

instance B.Types.GObject Accessible

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

instance O.HasParentTypes Accessible
type instance O.ParentTypes Accessible = '[GObject.Object.Object]

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

-- | Convert 'Accessible' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Accessible) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_accessible_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Accessible -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Accessible
P.Nothing = Ptr GValue -> Ptr Accessible -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Accessible
forall a. Ptr a
FP.nullPtr :: FP.Ptr Accessible)
    gvalueSet_ Ptr GValue
gv (P.Just Accessible
obj) = Accessible -> (Ptr Accessible -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Accessible
obj (Ptr GValue -> Ptr Accessible -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Accessible)
gvalueGet_ Ptr GValue
gv = do
        Ptr Accessible
ptr <- Ptr GValue -> IO (Ptr Accessible)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Accessible)
        if Ptr Accessible
ptr Ptr Accessible -> Ptr Accessible -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Accessible
forall a. Ptr a
FP.nullPtr
        then Accessible -> Maybe Accessible
forall a. a -> Maybe a
P.Just (Accessible -> Maybe Accessible)
-> IO Accessible -> IO (Maybe Accessible)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Accessible -> Accessible)
-> Ptr Accessible -> IO Accessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Accessible -> Accessible
Accessible Ptr Accessible
ptr
        else Maybe Accessible -> IO (Maybe Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Accessible
forall a. Maybe a
P.Nothing
        
    

-- VVV Prop "accessible-role"
   -- Type: TInterface (Name {namespace = "Gtk", name = "AccessibleRole"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

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

-- | Set the value of the “@accessible-role@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' accessible [ #accessibleRole 'Data.GI.Base.Attributes.:=' value ]
-- @
setAccessibleAccessibleRole :: (MonadIO m, IsAccessible o) => o -> Gtk.Enums.AccessibleRole -> m ()
setAccessibleAccessibleRole :: forall (m :: * -> *) o.
(MonadIO m, IsAccessible o) =>
o -> AccessibleRole -> m ()
setAccessibleAccessibleRole o
obj AccessibleRole
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 -> AccessibleRole -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"accessible-role" AccessibleRole
val

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

#if defined(ENABLE_OVERLOADING)
data AccessibleAccessibleRolePropertyInfo
instance AttrInfo AccessibleAccessibleRolePropertyInfo where
    type AttrAllowedOps AccessibleAccessibleRolePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AccessibleAccessibleRolePropertyInfo = IsAccessible
    type AttrSetTypeConstraint AccessibleAccessibleRolePropertyInfo = (~) Gtk.Enums.AccessibleRole
    type AttrTransferTypeConstraint AccessibleAccessibleRolePropertyInfo = (~) Gtk.Enums.AccessibleRole
    type AttrTransferType AccessibleAccessibleRolePropertyInfo = Gtk.Enums.AccessibleRole
    type AttrGetType AccessibleAccessibleRolePropertyInfo = Gtk.Enums.AccessibleRole
    type AttrLabel AccessibleAccessibleRolePropertyInfo = "accessible-role"
    type AttrOrigin AccessibleAccessibleRolePropertyInfo = Accessible
    attrGet = getAccessibleAccessibleRole
    attrSet = setAccessibleAccessibleRole
    attrTransfer _ v = do
        return v
    attrConstruct = constructAccessibleAccessibleRole
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleRole"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#g:attr:accessibleRole"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Accessible
type instance O.AttributeList Accessible = AccessibleAttributeList
type AccessibleAttributeList = ('[ '("accessibleRole", AccessibleAccessibleRolePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
accessibleAccessibleRole :: AttrLabelProxy "accessibleRole"
accessibleAccessibleRole = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAccessibleMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveAccessibleMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAccessibleMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAccessibleMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAccessibleMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAccessibleMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAccessibleMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAccessibleMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAccessibleMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAccessibleMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAccessibleMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAccessibleMethod "resetProperty" o = AccessibleResetPropertyMethodInfo
    ResolveAccessibleMethod "resetRelation" o = AccessibleResetRelationMethodInfo
    ResolveAccessibleMethod "resetState" o = AccessibleResetStateMethodInfo
    ResolveAccessibleMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAccessibleMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAccessibleMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAccessibleMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAccessibleMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAccessibleMethod "updateNextAccessibleSibling" o = AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveAccessibleMethod "updateProperty" o = AccessibleUpdatePropertyMethodInfo
    ResolveAccessibleMethod "updateRelation" o = AccessibleUpdateRelationMethodInfo
    ResolveAccessibleMethod "updateState" o = AccessibleUpdateStateMethodInfo
    ResolveAccessibleMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAccessibleMethod "getAccessibleParent" o = AccessibleGetAccessibleParentMethodInfo
    ResolveAccessibleMethod "getAccessibleRole" o = AccessibleGetAccessibleRoleMethodInfo
    ResolveAccessibleMethod "getAtContext" o = AccessibleGetAtContextMethodInfo
    ResolveAccessibleMethod "getBounds" o = AccessibleGetBoundsMethodInfo
    ResolveAccessibleMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAccessibleMethod "getFirstAccessibleChild" o = AccessibleGetFirstAccessibleChildMethodInfo
    ResolveAccessibleMethod "getNextAccessibleSibling" o = AccessibleGetNextAccessibleSiblingMethodInfo
    ResolveAccessibleMethod "getPlatformState" o = AccessibleGetPlatformStateMethodInfo
    ResolveAccessibleMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAccessibleMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAccessibleMethod "setAccessibleParent" o = AccessibleSetAccessibleParentMethodInfo
    ResolveAccessibleMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAccessibleMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAccessibleMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAccessibleMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Accessible::get_accessible_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Accessible" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_accessible_parent" gtk_accessible_get_accessible_parent :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO (Ptr Accessible)

-- | Retrieves the accessible parent for an accessible object.
-- 
-- This function returns @NULL@ for top level widgets.
-- 
-- /Since: 4.10/
accessibleGetAccessibleParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> m (Maybe Accessible)
    -- ^ __Returns:__ the accessible parent
accessibleGetAccessibleParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> m (Maybe Accessible)
accessibleGetAccessibleParent a
self = IO (Maybe Accessible) -> m (Maybe Accessible)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Accessible) -> m (Maybe Accessible))
-> IO (Maybe Accessible) -> m (Maybe Accessible)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Accessible
result <- Ptr Accessible -> IO (Ptr Accessible)
gtk_accessible_get_accessible_parent Ptr Accessible
self'
    Maybe Accessible
maybeResult <- Ptr Accessible
-> (Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Accessible
result ((Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible))
-> (Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible)
forall a b. (a -> b) -> a -> b
$ \Ptr Accessible
result' -> do
        Accessible
result'' <- ((ManagedPtr Accessible -> Accessible)
-> Ptr Accessible -> IO Accessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Accessible -> Accessible
Accessible) Ptr Accessible
result'
        Accessible -> IO Accessible
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Accessible
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Accessible -> IO (Maybe Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Accessible
maybeResult

#if defined(ENABLE_OVERLOADING)
data AccessibleGetAccessibleParentMethodInfo
instance (signature ~ (m (Maybe Accessible)), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetAccessibleParentMethodInfo a signature where
    overloadedMethod = accessibleGetAccessibleParent

instance O.OverloadedMethodInfo AccessibleGetAccessibleParentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetAccessibleParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetAccessibleParent"
        })


#endif

-- method Accessible::get_accessible_role
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "AccessibleRole" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_accessible_role" gtk_accessible_get_accessible_role :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO CUInt

-- | Retrieves the accessible role of an accessible object.
accessibleGetAccessibleRole ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: an accessible object
    -> m Gtk.Enums.AccessibleRole
    -- ^ __Returns:__ the accessible role
accessibleGetAccessibleRole :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> m AccessibleRole
accessibleGetAccessibleRole a
self = IO AccessibleRole -> m AccessibleRole
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccessibleRole -> m AccessibleRole)
-> IO AccessibleRole -> m AccessibleRole
forall a b. (a -> b) -> a -> b
$ do
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Accessible -> IO CUInt
gtk_accessible_get_accessible_role Ptr Accessible
self'
    let result' :: AccessibleRole
result' = (Int -> AccessibleRole
forall a. Enum a => Int -> a
toEnum (Int -> AccessibleRole)
-> (CUInt -> Int) -> CUInt -> AccessibleRole
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
self
    AccessibleRole -> IO AccessibleRole
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AccessibleRole
result'

#if defined(ENABLE_OVERLOADING)
data AccessibleGetAccessibleRoleMethodInfo
instance (signature ~ (m Gtk.Enums.AccessibleRole), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetAccessibleRoleMethodInfo a signature where
    overloadedMethod = accessibleGetAccessibleRole

instance O.OverloadedMethodInfo AccessibleGetAccessibleRoleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetAccessibleRole",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetAccessibleRole"
        })


#endif

-- method Accessible::get_at_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "ATContext" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_at_context" gtk_accessible_get_at_context :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO (Ptr Gtk.ATContext.ATContext)

-- | Retrieves the accessible implementation for the given @GtkAccessible@.
-- 
-- /Since: 4.10/
accessibleGetAtContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> m Gtk.ATContext.ATContext
    -- ^ __Returns:__ the accessible implementation object
accessibleGetAtContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> m ATContext
accessibleGetAtContext a
self = IO ATContext -> m ATContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ATContext -> m ATContext) -> IO ATContext -> m ATContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ATContext
result <- Ptr Accessible -> IO (Ptr ATContext)
gtk_accessible_get_at_context Ptr Accessible
self'
    Text -> Ptr ATContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"accessibleGetAtContext" Ptr ATContext
result
    ATContext
result' <- ((ManagedPtr ATContext -> ATContext)
-> Ptr ATContext -> IO ATContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ATContext -> ATContext
Gtk.ATContext.ATContext) Ptr ATContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ATContext -> IO ATContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ATContext
result'

#if defined(ENABLE_OVERLOADING)
data AccessibleGetAtContextMethodInfo
instance (signature ~ (m Gtk.ATContext.ATContext), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetAtContextMethodInfo a signature where
    overloadedMethod = accessibleGetAtContext

instance O.OverloadedMethodInfo AccessibleGetAtContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetAtContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetAtContext"
        })


#endif

-- method Accessible::get_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the x coordinate of the top left corner of the accessible"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the y coordinate of the top left corner of the widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of the accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of the accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_bounds" gtk_accessible_get_bounds :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Ptr Int32 ->                            -- x : TBasicType TInt
    Ptr Int32 ->                            -- y : TBasicType TInt
    Ptr Int32 ->                            -- width : TBasicType TInt
    Ptr Int32 ->                            -- height : TBasicType TInt
    IO CInt

-- | Queries the coordinates and dimensions of this accessible
-- 
-- This functionality can be overridden by @GtkAccessible@
-- implementations, e.g. to get the bounds from an ignored
-- child widget.
-- 
-- /Since: 4.10/
accessibleGetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> m ((Bool, Int32, Int32, Int32, Int32))
    -- ^ __Returns:__ true if the bounds are valid, and false otherwise
accessibleGetBounds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> m (Bool, Int32, Int32, Int32, Int32)
accessibleGetBounds a
self = IO (Bool, Int32, Int32, Int32, Int32)
-> m (Bool, Int32, Int32, Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32, Int32, Int32)
 -> m (Bool, Int32, Int32, Int32, Int32))
-> IO (Bool, Int32, Int32, Int32, Int32)
-> m (Bool, Int32, Int32, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Int32
x <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
y <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
width <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
height <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Accessible
-> Ptr Int32 -> Ptr Int32 -> Ptr Int32 -> Ptr Int32 -> IO CInt
gtk_accessible_get_bounds Ptr Accessible
self' Ptr Int32
x Ptr Int32
y Ptr Int32
width Ptr Int32
height
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
x' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x
    Int32
y' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y
    Int32
width' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
width
    Int32
height' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
height
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
x
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
y
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
width
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
height
    (Bool, Int32, Int32, Int32, Int32)
-> IO (Bool, Int32, Int32, Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
x', Int32
y', Int32
width', Int32
height')

#if defined(ENABLE_OVERLOADING)
data AccessibleGetBoundsMethodInfo
instance (signature ~ (m ((Bool, Int32, Int32, Int32, Int32))), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetBoundsMethodInfo a signature where
    overloadedMethod = accessibleGetBounds

instance O.OverloadedMethodInfo AccessibleGetBoundsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetBounds",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetBounds"
        })


#endif

-- method Accessible::get_first_accessible_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Accessible" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_first_accessible_child" gtk_accessible_get_first_accessible_child :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO (Ptr Accessible)

-- | Retrieves the first accessible child of an accessible object.
-- 
-- /Since: 4.10/
accessibleGetFirstAccessibleChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: an accessible object
    -> m (Maybe Accessible)
    -- ^ __Returns:__ the first accessible child
accessibleGetFirstAccessibleChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> m (Maybe Accessible)
accessibleGetFirstAccessibleChild a
self = IO (Maybe Accessible) -> m (Maybe Accessible)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Accessible) -> m (Maybe Accessible))
-> IO (Maybe Accessible) -> m (Maybe Accessible)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Accessible
result <- Ptr Accessible -> IO (Ptr Accessible)
gtk_accessible_get_first_accessible_child Ptr Accessible
self'
    Maybe Accessible
maybeResult <- Ptr Accessible
-> (Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Accessible
result ((Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible))
-> (Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible)
forall a b. (a -> b) -> a -> b
$ \Ptr Accessible
result' -> do
        Accessible
result'' <- ((ManagedPtr Accessible -> Accessible)
-> Ptr Accessible -> IO Accessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Accessible -> Accessible
Accessible) Ptr Accessible
result'
        Accessible -> IO Accessible
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Accessible
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Accessible -> IO (Maybe Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Accessible
maybeResult

#if defined(ENABLE_OVERLOADING)
data AccessibleGetFirstAccessibleChildMethodInfo
instance (signature ~ (m (Maybe Accessible)), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetFirstAccessibleChildMethodInfo a signature where
    overloadedMethod = accessibleGetFirstAccessibleChild

instance O.OverloadedMethodInfo AccessibleGetFirstAccessibleChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetFirstAccessibleChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetFirstAccessibleChild"
        })


#endif

-- method Accessible::get_next_accessible_sibling
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Accessible" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_next_accessible_sibling" gtk_accessible_get_next_accessible_sibling :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO (Ptr Accessible)

-- | Retrieves the next accessible sibling of an accessible object
-- 
-- /Since: 4.10/
accessibleGetNextAccessibleSibling ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: an accessible object
    -> m (Maybe Accessible)
    -- ^ __Returns:__ the next accessible sibling
accessibleGetNextAccessibleSibling :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> m (Maybe Accessible)
accessibleGetNextAccessibleSibling a
self = IO (Maybe Accessible) -> m (Maybe Accessible)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Accessible) -> m (Maybe Accessible))
-> IO (Maybe Accessible) -> m (Maybe Accessible)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Accessible
result <- Ptr Accessible -> IO (Ptr Accessible)
gtk_accessible_get_next_accessible_sibling Ptr Accessible
self'
    Maybe Accessible
maybeResult <- Ptr Accessible
-> (Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Accessible
result ((Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible))
-> (Ptr Accessible -> IO Accessible) -> IO (Maybe Accessible)
forall a b. (a -> b) -> a -> b
$ \Ptr Accessible
result' -> do
        Accessible
result'' <- ((ManagedPtr Accessible -> Accessible)
-> Ptr Accessible -> IO Accessible
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Accessible -> Accessible
Accessible) Ptr Accessible
result'
        Accessible -> IO Accessible
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Accessible
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Accessible -> IO (Maybe Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Accessible
maybeResult

#if defined(ENABLE_OVERLOADING)
data AccessibleGetNextAccessibleSiblingMethodInfo
instance (signature ~ (m (Maybe Accessible)), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetNextAccessibleSiblingMethodInfo a signature where
    overloadedMethod = accessibleGetNextAccessibleSibling

instance O.OverloadedMethodInfo AccessibleGetNextAccessibleSiblingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetNextAccessibleSibling",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetNextAccessibleSibling"
        })


#endif

-- method Accessible::get_platform_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "AccessiblePlatformState" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "platform state to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_get_platform_state" gtk_accessible_get_platform_state :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gtk", name = "AccessiblePlatformState"})
    IO CInt

-- | Query a platform state, such as focus.
-- 
-- See @/gtk_accessible_platform_changed()/@.
-- 
-- This functionality can be overridden by @GtkAccessible@
-- implementations, e.g. to get platform state from an ignored
-- child widget, as is the case for @GtkText@ wrappers.
-- 
-- /Since: 4.10/
accessibleGetPlatformState ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> Gtk.Enums.AccessiblePlatformState
    -- ^ /@state@/: platform state to query
    -> m Bool
    -- ^ __Returns:__ the value of /@state@/ for the accessible
accessibleGetPlatformState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> AccessiblePlatformState -> m Bool
accessibleGetPlatformState a
self AccessiblePlatformState
state = 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 Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessiblePlatformState -> Int)
-> AccessiblePlatformState
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessiblePlatformState -> Int
forall a. Enum a => a -> Int
fromEnum) AccessiblePlatformState
state
    CInt
result <- Ptr Accessible -> CUInt -> IO CInt
gtk_accessible_get_platform_state Ptr Accessible
self' CUInt
state'
    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
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AccessibleGetPlatformStateMethodInfo
instance (signature ~ (Gtk.Enums.AccessiblePlatformState -> m Bool), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleGetPlatformStateMethodInfo a signature where
    overloadedMethod = accessibleGetPlatformState

instance O.OverloadedMethodInfo AccessibleGetPlatformStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleGetPlatformState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleGetPlatformState"
        })


#endif

-- method Accessible::reset_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccessibleProperty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessibleProperty`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_reset_property" gtk_accessible_reset_property :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    CUInt ->                                -- property : TInterface (Name {namespace = "Gtk", name = "AccessibleProperty"})
    IO ()

-- | Resets the accessible /@property@/ to its default value.
accessibleResetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> Gtk.Enums.AccessibleProperty
    -- ^ /@property@/: a @GtkAccessibleProperty@
    -> m ()
accessibleResetProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> AccessibleProperty -> m ()
accessibleResetProperty a
self AccessibleProperty
property = 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 Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let property' :: CUInt
property' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessibleProperty -> Int) -> AccessibleProperty -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessibleProperty -> Int
forall a. Enum a => a -> Int
fromEnum) AccessibleProperty
property
    Ptr Accessible -> CUInt -> IO ()
gtk_accessible_reset_property Ptr Accessible
self' CUInt
property'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleResetPropertyMethodInfo
instance (signature ~ (Gtk.Enums.AccessibleProperty -> m ()), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleResetPropertyMethodInfo a signature where
    overloadedMethod = accessibleResetProperty

instance O.OverloadedMethodInfo AccessibleResetPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleResetProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleResetProperty"
        })


#endif

-- method Accessible::reset_relation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "relation"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccessibleRelation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessibleRelation`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_reset_relation" gtk_accessible_reset_relation :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    CUInt ->                                -- relation : TInterface (Name {namespace = "Gtk", name = "AccessibleRelation"})
    IO ()

-- | Resets the accessible /@relation@/ to its default value.
accessibleResetRelation ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> Gtk.Enums.AccessibleRelation
    -- ^ /@relation@/: a @GtkAccessibleRelation@
    -> m ()
accessibleResetRelation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> AccessibleRelation -> m ()
accessibleResetRelation a
self AccessibleRelation
relation = 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 Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let relation' :: CUInt
relation' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessibleRelation -> Int) -> AccessibleRelation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessibleRelation -> Int
forall a. Enum a => a -> Int
fromEnum) AccessibleRelation
relation
    Ptr Accessible -> CUInt -> IO ()
gtk_accessible_reset_relation Ptr Accessible
self' CUInt
relation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleResetRelationMethodInfo
instance (signature ~ (Gtk.Enums.AccessibleRelation -> m ()), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleResetRelationMethodInfo a signature where
    overloadedMethod = accessibleResetRelation

instance O.OverloadedMethodInfo AccessibleResetRelationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleResetRelation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleResetRelation"
        })


#endif

-- method Accessible::reset_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccessibleState" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessibleState`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_reset_state" gtk_accessible_reset_state :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gtk", name = "AccessibleState"})
    IO ()

-- | Resets the accessible /@state@/ to its default value.
accessibleResetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> Gtk.Enums.AccessibleState
    -- ^ /@state@/: a @GtkAccessibleState@
    -> m ()
accessibleResetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> AccessibleState -> m ()
accessibleResetState a
self AccessibleState
state = 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 Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessibleState -> Int) -> AccessibleState -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessibleState -> Int
forall a. Enum a => a -> Int
fromEnum) AccessibleState
state
    Ptr Accessible -> CUInt -> IO ()
gtk_accessible_reset_state Ptr Accessible
self' CUInt
state'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleResetStateMethodInfo
instance (signature ~ (Gtk.Enums.AccessibleState -> m ()), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleResetStateMethodInfo a signature where
    overloadedMethod = accessibleResetState

instance O.OverloadedMethodInfo AccessibleResetStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleResetState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleResetState"
        })


#endif

-- method Accessible::set_accessible_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "next_sibling"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sibling accessible object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_set_accessible_parent" gtk_accessible_set_accessible_parent :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Ptr Accessible ->                       -- parent : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Ptr Accessible ->                       -- next_sibling : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO ()

-- | Sets the parent and sibling of an accessible object.
-- 
-- This function is meant to be used by accessible implementations that are
-- not part of the widget hierarchy, and but act as a logical bridge between
-- widgets. For instance, if a widget creates an object that holds metadata
-- for each child, and you want that object to implement the @GtkAccessible@
-- interface, you will use this function to ensure that the parent of each
-- child widget is the metadata object, and the parent of each metadata
-- object is the container widget.
-- 
-- /Since: 4.10/
accessibleSetAccessibleParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a, IsAccessible b, IsAccessible c) =>
    a
    -- ^ /@self@/: an accessible object
    -> Maybe (b)
    -- ^ /@parent@/: the parent accessible object
    -> Maybe (c)
    -- ^ /@nextSibling@/: the sibling accessible object
    -> m ()
accessibleSetAccessibleParent :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsAccessible a, IsAccessible b,
 IsAccessible c) =>
a -> Maybe b -> Maybe c -> m ()
accessibleSetAccessibleParent a
self Maybe b
parent Maybe c
nextSibling = 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 Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Accessible
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Accessible -> IO (Ptr Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Accessible
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Accessible
jParent' <- b -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Accessible -> IO (Ptr Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Accessible
jParent'
    Ptr Accessible
maybeNextSibling <- case Maybe c
nextSibling of
        Maybe c
Nothing -> Ptr Accessible -> IO (Ptr Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Accessible
forall a. Ptr a
nullPtr
        Just c
jNextSibling -> do
            Ptr Accessible
jNextSibling' <- c -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jNextSibling
            Ptr Accessible -> IO (Ptr Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Accessible
jNextSibling'
    Ptr Accessible -> Ptr Accessible -> Ptr Accessible -> IO ()
gtk_accessible_set_accessible_parent Ptr Accessible
self' Ptr Accessible
maybeParent Ptr Accessible
maybeNextSibling
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
nextSibling c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleSetAccessibleParentMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> m ()), MonadIO m, IsAccessible a, IsAccessible b, IsAccessible c) => O.OverloadedMethod AccessibleSetAccessibleParentMethodInfo a signature where
    overloadedMethod = accessibleSetAccessibleParent

instance O.OverloadedMethodInfo AccessibleSetAccessibleParentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleSetAccessibleParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleSetAccessibleParent"
        })


#endif

-- method Accessible::update_next_accessible_sibling
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_sibling"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new next accessible sibling to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_update_next_accessible_sibling" gtk_accessible_update_next_accessible_sibling :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Ptr Accessible ->                       -- new_sibling : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    IO ()

-- | Updates the next accessible sibling of /@self@/.
-- 
-- That might be useful when a new child of a custom @GtkAccessible@
-- is created, and it needs to be linked to a previous child.
-- 
-- /Since: 4.10/
accessibleUpdateNextAccessibleSibling ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a, IsAccessible b) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> Maybe (b)
    -- ^ /@newSibling@/: the new next accessible sibling to set
    -> m ()
accessibleUpdateNextAccessibleSibling :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAccessible a, IsAccessible b) =>
a -> Maybe b -> m ()
accessibleUpdateNextAccessibleSibling a
self Maybe b
newSibling = 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 Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Accessible
maybeNewSibling <- case Maybe b
newSibling of
        Maybe b
Nothing -> Ptr Accessible -> IO (Ptr Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Accessible
forall a. Ptr a
nullPtr
        Just b
jNewSibling -> do
            Ptr Accessible
jNewSibling' <- b -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jNewSibling
            Ptr Accessible -> IO (Ptr Accessible)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Accessible
jNewSibling'
    Ptr Accessible -> Ptr Accessible -> IO ()
gtk_accessible_update_next_accessible_sibling Ptr Accessible
self' Ptr Accessible
maybeNewSibling
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
newSibling b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleUpdateNextAccessibleSiblingMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsAccessible a, IsAccessible b) => O.OverloadedMethod AccessibleUpdateNextAccessibleSiblingMethodInfo a signature where
    overloadedMethod = accessibleUpdateNextAccessibleSibling

instance O.OverloadedMethodInfo AccessibleUpdateNextAccessibleSiblingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleUpdateNextAccessibleSibling",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleUpdateNextAccessibleSibling"
        })


#endif

-- method Accessible::update_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_properties"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of accessible properties to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "properties"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface
--                    Name { namespace = "Gtk" , name = "AccessibleProperty" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of `GtkAccessibleProperty`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 1 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of `GValues`, one for each property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_properties"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of accessible properties to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_properties"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of accessible properties to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_update_property_value" gtk_accessible_update_property_value :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Int32 ->                                -- n_properties : TBasicType TInt
    Ptr CUInt ->                            -- properties : TCArray False (-1) 1 (TInterface (Name {namespace = "Gtk", name = "AccessibleProperty"}))
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 1 TGValue
    IO ()

-- | Updates an array of accessible properties.
-- 
-- This function should be called by @GtkWidget@ types whenever an accessible
-- property change must be communicated to assistive technologies.
-- 
-- This function is meant to be used by language bindings.
accessibleUpdateProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> [Gtk.Enums.AccessibleProperty]
    -- ^ /@properties@/: an array of @GtkAccessibleProperty@
    -> [GValue]
    -- ^ /@values@/: an array of @GValues@, one for each property
    -> m ()
accessibleUpdateProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> [AccessibleProperty] -> [GValue] -> m ()
accessibleUpdateProperty a
self [AccessibleProperty]
properties [GValue]
values = 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
    let nProperties :: Int32
nProperties = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let properties_expected_length_ :: Int32
properties_expected_length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [AccessibleProperty] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [AccessibleProperty]
properties
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
properties_expected_length_ Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
nProperties) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Gtk.accessibleUpdateProperty : length of 'properties' does not agree with that of 'values'."
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let properties' :: [CUInt]
properties' = (AccessibleProperty -> CUInt) -> [AccessibleProperty] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessibleProperty -> Int) -> AccessibleProperty -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessibleProperty -> Int
forall a. Enum a => a -> Int
fromEnum) [AccessibleProperty]
properties
    Ptr CUInt
properties'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
properties'
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    Ptr Accessible -> Int32 -> Ptr CUInt -> Ptr GValue -> IO ()
gtk_accessible_update_property_value Ptr Accessible
self' Int32
nProperties Ptr CUInt
properties'' Ptr GValue
values'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
properties''
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleUpdatePropertyMethodInfo
instance (signature ~ ([Gtk.Enums.AccessibleProperty] -> [GValue] -> m ()), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleUpdatePropertyMethodInfo a signature where
    overloadedMethod = accessibleUpdateProperty

instance O.OverloadedMethodInfo AccessibleUpdatePropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleUpdateProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleUpdateProperty"
        })


#endif

-- method Accessible::update_relation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_relations"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of accessible relations to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "relations"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface
--                    Name { namespace = "Gtk" , name = "AccessibleRelation" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of `GtkAccessibleRelation`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 1 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of `GValues`, one for each relation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_relations"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of accessible relations to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_relations"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of accessible relations to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_update_relation_value" gtk_accessible_update_relation_value :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Int32 ->                                -- n_relations : TBasicType TInt
    Ptr CUInt ->                            -- relations : TCArray False (-1) 1 (TInterface (Name {namespace = "Gtk", name = "AccessibleRelation"}))
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 1 TGValue
    IO ()

-- | Updates an array of accessible relations.
-- 
-- This function should be called by @GtkWidget@ types whenever an accessible
-- relation change must be communicated to assistive technologies.
-- 
-- This function is meant to be used by language bindings.
accessibleUpdateRelation ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> [Gtk.Enums.AccessibleRelation]
    -- ^ /@relations@/: an array of @GtkAccessibleRelation@
    -> [GValue]
    -- ^ /@values@/: an array of @GValues@, one for each relation
    -> m ()
accessibleUpdateRelation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> [AccessibleRelation] -> [GValue] -> m ()
accessibleUpdateRelation a
self [AccessibleRelation]
relations [GValue]
values = 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
    let nRelations :: Int32
nRelations = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let relations_expected_length_ :: Int32
relations_expected_length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [AccessibleRelation] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [AccessibleRelation]
relations
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
relations_expected_length_ Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
nRelations) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Gtk.accessibleUpdateRelation : length of 'relations' does not agree with that of 'values'."
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let relations' :: [CUInt]
relations' = (AccessibleRelation -> CUInt) -> [AccessibleRelation] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessibleRelation -> Int) -> AccessibleRelation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessibleRelation -> Int
forall a. Enum a => a -> Int
fromEnum) [AccessibleRelation]
relations
    Ptr CUInt
relations'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
relations'
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    Ptr Accessible -> Int32 -> Ptr CUInt -> Ptr GValue -> IO ()
gtk_accessible_update_relation_value Ptr Accessible
self' Int32
nRelations Ptr CUInt
relations'' Ptr GValue
values'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
relations''
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleUpdateRelationMethodInfo
instance (signature ~ ([Gtk.Enums.AccessibleRelation] -> [GValue] -> m ()), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleUpdateRelationMethodInfo a signature where
    overloadedMethod = accessibleUpdateRelation

instance O.OverloadedMethodInfo AccessibleUpdateRelationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleUpdateRelation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleUpdateRelation"
        })


#endif

-- method Accessible::update_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Accessible" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAccessible`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_states"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of accessible states to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "states"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Gtk" , name = "AccessibleState" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of `GtkAccessibleState`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 1 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of `GValues`, one for each state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_states"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of accessible states to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_states"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of accessible states to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accessible_update_state_value" gtk_accessible_update_state_value :: 
    Ptr Accessible ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Accessible"})
    Int32 ->                                -- n_states : TBasicType TInt
    Ptr CUInt ->                            -- states : TCArray False (-1) 1 (TInterface (Name {namespace = "Gtk", name = "AccessibleState"}))
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 1 TGValue
    IO ()

-- | Updates an array of accessible states.
-- 
-- This function should be called by @GtkWidget@ types whenever an accessible
-- state change must be communicated to assistive technologies.
-- 
-- This function is meant to be used by language bindings.
accessibleUpdateState ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccessible a) =>
    a
    -- ^ /@self@/: a @GtkAccessible@
    -> [Gtk.Enums.AccessibleState]
    -- ^ /@states@/: an array of @GtkAccessibleState@
    -> [GValue]
    -- ^ /@values@/: an array of @GValues@, one for each state
    -> m ()
accessibleUpdateState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAccessible a) =>
a -> [AccessibleState] -> [GValue] -> m ()
accessibleUpdateState a
self [AccessibleState]
states [GValue]
values = 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
    let nStates :: Int32
nStates = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let states_expected_length_ :: Int32
states_expected_length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [AccessibleState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [AccessibleState]
states
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
states_expected_length_ Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
nStates) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Gtk.accessibleUpdateState : length of 'states' does not agree with that of 'values'."
    Ptr Accessible
self' <- a -> IO (Ptr Accessible)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let states' :: [CUInt]
states' = (AccessibleState -> CUInt) -> [AccessibleState] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AccessibleState -> Int) -> AccessibleState -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessibleState -> Int
forall a. Enum a => a -> Int
fromEnum) [AccessibleState]
states
    Ptr CUInt
states'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
states'
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    Ptr Accessible -> Int32 -> Ptr CUInt -> Ptr GValue -> IO ()
gtk_accessible_update_state_value Ptr Accessible
self' Int32
nStates Ptr CUInt
states'' Ptr GValue
values'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
states''
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccessibleUpdateStateMethodInfo
instance (signature ~ ([Gtk.Enums.AccessibleState] -> [GValue] -> m ()), MonadIO m, IsAccessible a) => O.OverloadedMethod AccessibleUpdateStateMethodInfo a signature where
    overloadedMethod = accessibleUpdateState

instance O.OverloadedMethodInfo AccessibleUpdateStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Interfaces.Accessible.accessibleUpdateState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Interfaces-Accessible.html#v:accessibleUpdateState"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Accessible = AccessibleSignalList
type AccessibleSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif