{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkListItem@ is used by list widgets to represent items in a
-- t'GI.Gio.Interfaces.ListModel.ListModel'.
-- 
-- @GtkListItem@ objects are managed by the list widget (with its factory)
-- and cannot be created by applications, but they need to be populated
-- by application code. This is done by calling 'GI.Gtk.Objects.ListItem.listItemSetChild'.
-- 
-- @GtkListItem@ objects exist in 2 stages:
-- 
-- 1. The unbound stage where the listitem is not currently connected to
--    an item in the list. In that case, the [ListItem:item]("GI.Gtk.Objects.ListItem#g:attr:item")
--    property is set to 'P.Nothing'.
-- 
-- 2. The bound stage where the listitem references an item from the list.
--    The [ListItem:item]("GI.Gtk.Objects.ListItem#g:attr:item") property is not 'P.Nothing'.

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

module GI.Gtk.Objects.ListItem
    ( 

-- * Exported types
    ListItem(..)                            ,
    IsListItem                              ,
    toListItem                              ,


 -- * 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"), [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"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleDescription]("GI.Gtk.Objects.ListItem#g:method:getAccessibleDescription"), [getAccessibleLabel]("GI.Gtk.Objects.ListItem#g:method:getAccessibleLabel"), [getActivatable]("GI.Gtk.Objects.ListItem#g:method:getActivatable"), [getChild]("GI.Gtk.Objects.ListItem#g:method:getChild"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFocusable]("GI.Gtk.Objects.ListItem#g:method:getFocusable"), [getItem]("GI.Gtk.Objects.ListItem#g:method:getItem"), [getPosition]("GI.Gtk.Objects.ListItem#g:method:getPosition"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelectable]("GI.Gtk.Objects.ListItem#g:method:getSelectable"), [getSelected]("GI.Gtk.Objects.ListItem#g:method:getSelected").
-- 
-- ==== Setters
-- [setAccessibleDescription]("GI.Gtk.Objects.ListItem#g:method:setAccessibleDescription"), [setAccessibleLabel]("GI.Gtk.Objects.ListItem#g:method:setAccessibleLabel"), [setActivatable]("GI.Gtk.Objects.ListItem#g:method:setActivatable"), [setChild]("GI.Gtk.Objects.ListItem#g:method:setChild"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFocusable]("GI.Gtk.Objects.ListItem#g:method:setFocusable"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSelectable]("GI.Gtk.Objects.ListItem#g:method:setSelectable").

#if defined(ENABLE_OVERLOADING)
    ResolveListItemMethod                   ,
#endif

-- ** getAccessibleDescription #method:getAccessibleDescription#

#if defined(ENABLE_OVERLOADING)
    ListItemGetAccessibleDescriptionMethodInfo,
#endif
    listItemGetAccessibleDescription        ,


-- ** getAccessibleLabel #method:getAccessibleLabel#

#if defined(ENABLE_OVERLOADING)
    ListItemGetAccessibleLabelMethodInfo    ,
#endif
    listItemGetAccessibleLabel              ,


-- ** getActivatable #method:getActivatable#

#if defined(ENABLE_OVERLOADING)
    ListItemGetActivatableMethodInfo        ,
#endif
    listItemGetActivatable                  ,


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    ListItemGetChildMethodInfo              ,
#endif
    listItemGetChild                        ,


-- ** getFocusable #method:getFocusable#

#if defined(ENABLE_OVERLOADING)
    ListItemGetFocusableMethodInfo          ,
#endif
    listItemGetFocusable                    ,


-- ** getItem #method:getItem#

#if defined(ENABLE_OVERLOADING)
    ListItemGetItemMethodInfo               ,
#endif
    listItemGetItem                         ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    ListItemGetPositionMethodInfo           ,
#endif
    listItemGetPosition                     ,


-- ** getSelectable #method:getSelectable#

#if defined(ENABLE_OVERLOADING)
    ListItemGetSelectableMethodInfo         ,
#endif
    listItemGetSelectable                   ,


-- ** getSelected #method:getSelected#

#if defined(ENABLE_OVERLOADING)
    ListItemGetSelectedMethodInfo           ,
#endif
    listItemGetSelected                     ,


-- ** setAccessibleDescription #method:setAccessibleDescription#

#if defined(ENABLE_OVERLOADING)
    ListItemSetAccessibleDescriptionMethodInfo,
#endif
    listItemSetAccessibleDescription        ,


-- ** setAccessibleLabel #method:setAccessibleLabel#

#if defined(ENABLE_OVERLOADING)
    ListItemSetAccessibleLabelMethodInfo    ,
#endif
    listItemSetAccessibleLabel              ,


-- ** setActivatable #method:setActivatable#

#if defined(ENABLE_OVERLOADING)
    ListItemSetActivatableMethodInfo        ,
#endif
    listItemSetActivatable                  ,


-- ** setChild #method:setChild#

#if defined(ENABLE_OVERLOADING)
    ListItemSetChildMethodInfo              ,
#endif
    listItemSetChild                        ,


-- ** setFocusable #method:setFocusable#

#if defined(ENABLE_OVERLOADING)
    ListItemSetFocusableMethodInfo          ,
#endif
    listItemSetFocusable                    ,


-- ** setSelectable #method:setSelectable#

#if defined(ENABLE_OVERLOADING)
    ListItemSetSelectableMethodInfo         ,
#endif
    listItemSetSelectable                   ,




 -- * Properties


-- ** accessibleDescription #attr:accessibleDescription#
-- | The accessible description to set on the list item.
-- 
-- /Since: 4.12/

#if defined(ENABLE_OVERLOADING)
    ListItemAccessibleDescriptionPropertyInfo,
#endif
    constructListItemAccessibleDescription  ,
    getListItemAccessibleDescription        ,
#if defined(ENABLE_OVERLOADING)
    listItemAccessibleDescription           ,
#endif
    setListItemAccessibleDescription        ,


-- ** accessibleLabel #attr:accessibleLabel#
-- | The accessible label to set on the list item.
-- 
-- /Since: 4.12/

#if defined(ENABLE_OVERLOADING)
    ListItemAccessibleLabelPropertyInfo     ,
#endif
    constructListItemAccessibleLabel        ,
    getListItemAccessibleLabel              ,
#if defined(ENABLE_OVERLOADING)
    listItemAccessibleLabel                 ,
#endif
    setListItemAccessibleLabel              ,


-- ** activatable #attr:activatable#
-- | If the item can be activated by the user.

#if defined(ENABLE_OVERLOADING)
    ListItemActivatablePropertyInfo         ,
#endif
    constructListItemActivatable            ,
    getListItemActivatable                  ,
#if defined(ENABLE_OVERLOADING)
    listItemActivatable                     ,
#endif
    setListItemActivatable                  ,


-- ** child #attr:child#
-- | Widget used for display.

#if defined(ENABLE_OVERLOADING)
    ListItemChildPropertyInfo               ,
#endif
    clearListItemChild                      ,
    constructListItemChild                  ,
    getListItemChild                        ,
#if defined(ENABLE_OVERLOADING)
    listItemChild                           ,
#endif
    setListItemChild                        ,


-- ** focusable #attr:focusable#
-- | If the item can be focused with the keyboard.
-- 
-- /Since: 4.12/

#if defined(ENABLE_OVERLOADING)
    ListItemFocusablePropertyInfo           ,
#endif
    constructListItemFocusable              ,
    getListItemFocusable                    ,
#if defined(ENABLE_OVERLOADING)
    listItemFocusable                       ,
#endif
    setListItemFocusable                    ,


-- ** item #attr:item#
-- | Displayed item.

#if defined(ENABLE_OVERLOADING)
    ListItemItemPropertyInfo                ,
#endif
    getListItemItem                         ,
#if defined(ENABLE_OVERLOADING)
    listItemItem                            ,
#endif


-- ** position #attr:position#
-- | Position of the item.

#if defined(ENABLE_OVERLOADING)
    ListItemPositionPropertyInfo            ,
#endif
    getListItemPosition                     ,
#if defined(ENABLE_OVERLOADING)
    listItemPosition                        ,
#endif


-- ** selectable #attr:selectable#
-- | If the item can be selected by the user.

#if defined(ENABLE_OVERLOADING)
    ListItemSelectablePropertyInfo          ,
#endif
    constructListItemSelectable             ,
    getListItemSelectable                   ,
#if defined(ENABLE_OVERLOADING)
    listItemSelectable                      ,
#endif
    setListItemSelectable                   ,


-- ** selected #attr:selected#
-- | If the item is currently selected.

#if defined(ENABLE_OVERLOADING)
    ListItemSelectedPropertyInfo            ,
#endif
    getListItemSelected                     ,
#if defined(ENABLE_OVERLOADING)
    listItemSelected                        ,
#endif




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Objects.Renderer as Gsk.Renderer
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.Path as Gsk.Path
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Stroke as Gsk.Stroke
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Snapshot as Gtk.Snapshot
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "gtk_list_item_get_type"
    c_gtk_list_item_get_type :: IO B.Types.GType

instance B.Types.TypedObject ListItem where
    glibType :: IO GType
glibType = IO GType
c_gtk_list_item_get_type

instance B.Types.GObject ListItem

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

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

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

-- | Convert 'ListItem' 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 ListItem) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_list_item_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ListItem -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ListItem
P.Nothing = Ptr GValue -> Ptr ListItem -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ListItem
forall a. Ptr a
FP.nullPtr :: FP.Ptr ListItem)
    gvalueSet_ Ptr GValue
gv (P.Just ListItem
obj) = ListItem -> (Ptr ListItem -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ListItem
obj (Ptr GValue -> Ptr ListItem -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ListItem)
gvalueGet_ Ptr GValue
gv = do
        Ptr ListItem
ptr <- Ptr GValue -> IO (Ptr ListItem)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ListItem)
        if Ptr ListItem
ptr Ptr ListItem -> Ptr ListItem -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ListItem
forall a. Ptr a
FP.nullPtr
        then ListItem -> Maybe ListItem
forall a. a -> Maybe a
P.Just (ListItem -> Maybe ListItem) -> IO ListItem -> IO (Maybe ListItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ListItem -> ListItem) -> Ptr ListItem -> IO ListItem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ListItem -> ListItem
ListItem Ptr ListItem
ptr
        else Maybe ListItem -> IO (Maybe ListItem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListItem
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveListItemMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveListItemMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveListItemMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveListItemMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveListItemMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveListItemMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveListItemMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveListItemMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveListItemMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveListItemMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveListItemMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveListItemMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveListItemMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveListItemMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveListItemMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveListItemMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveListItemMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveListItemMethod "getAccessibleDescription" o = ListItemGetAccessibleDescriptionMethodInfo
    ResolveListItemMethod "getAccessibleLabel" o = ListItemGetAccessibleLabelMethodInfo
    ResolveListItemMethod "getActivatable" o = ListItemGetActivatableMethodInfo
    ResolveListItemMethod "getChild" o = ListItemGetChildMethodInfo
    ResolveListItemMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveListItemMethod "getFocusable" o = ListItemGetFocusableMethodInfo
    ResolveListItemMethod "getItem" o = ListItemGetItemMethodInfo
    ResolveListItemMethod "getPosition" o = ListItemGetPositionMethodInfo
    ResolveListItemMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveListItemMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveListItemMethod "getSelectable" o = ListItemGetSelectableMethodInfo
    ResolveListItemMethod "getSelected" o = ListItemGetSelectedMethodInfo
    ResolveListItemMethod "setAccessibleDescription" o = ListItemSetAccessibleDescriptionMethodInfo
    ResolveListItemMethod "setAccessibleLabel" o = ListItemSetAccessibleLabelMethodInfo
    ResolveListItemMethod "setActivatable" o = ListItemSetActivatableMethodInfo
    ResolveListItemMethod "setChild" o = ListItemSetChildMethodInfo
    ResolveListItemMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveListItemMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveListItemMethod "setFocusable" o = ListItemSetFocusableMethodInfo
    ResolveListItemMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveListItemMethod "setSelectable" o = ListItemSetSelectableMethodInfo
    ResolveListItemMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "accessible-description"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@accessible-description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #accessibleDescription
-- @
getListItemAccessibleDescription :: (MonadIO m, IsListItem o) => o -> m T.Text
getListItemAccessibleDescription :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Text
getListItemAccessibleDescription o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getListItemAccessibleDescription" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"accessible-description"

-- | Set the value of the “@accessible-description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' listItem [ #accessibleDescription 'Data.GI.Base.Attributes.:=' value ]
-- @
setListItemAccessibleDescription :: (MonadIO m, IsListItem o) => o -> T.Text -> m ()
setListItemAccessibleDescription :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> Text -> m ()
setListItemAccessibleDescription o
obj Text
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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accessible-description" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@accessible-description@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListItemAccessibleDescription :: (IsListItem o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructListItemAccessibleDescription :: forall o (m :: * -> *).
(IsListItem o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructListItemAccessibleDescription Text
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"accessible-description" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ListItemAccessibleDescriptionPropertyInfo
instance AttrInfo ListItemAccessibleDescriptionPropertyInfo where
    type AttrAllowedOps ListItemAccessibleDescriptionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ListItemAccessibleDescriptionPropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemAccessibleDescriptionPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ListItemAccessibleDescriptionPropertyInfo = (~) T.Text
    type AttrTransferType ListItemAccessibleDescriptionPropertyInfo = T.Text
    type AttrGetType ListItemAccessibleDescriptionPropertyInfo = T.Text
    type AttrLabel ListItemAccessibleDescriptionPropertyInfo = "accessible-description"
    type AttrOrigin ListItemAccessibleDescriptionPropertyInfo = ListItem
    attrGet = getListItemAccessibleDescription
    attrSet = setListItemAccessibleDescription
    attrTransfer _ v = do
        return v
    attrConstruct = constructListItemAccessibleDescription
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.accessibleDescription"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:accessibleDescription"
        })
#endif

-- VVV Prop "accessible-label"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@accessible-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #accessibleLabel
-- @
getListItemAccessibleLabel :: (MonadIO m, IsListItem o) => o -> m T.Text
getListItemAccessibleLabel :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Text
getListItemAccessibleLabel o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getListItemAccessibleLabel" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"accessible-label"

-- | Set the value of the “@accessible-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' listItem [ #accessibleLabel 'Data.GI.Base.Attributes.:=' value ]
-- @
setListItemAccessibleLabel :: (MonadIO m, IsListItem o) => o -> T.Text -> m ()
setListItemAccessibleLabel :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> Text -> m ()
setListItemAccessibleLabel o
obj Text
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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accessible-label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@accessible-label@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListItemAccessibleLabel :: (IsListItem o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructListItemAccessibleLabel :: forall o (m :: * -> *).
(IsListItem o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructListItemAccessibleLabel Text
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"accessible-label" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ListItemAccessibleLabelPropertyInfo
instance AttrInfo ListItemAccessibleLabelPropertyInfo where
    type AttrAllowedOps ListItemAccessibleLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ListItemAccessibleLabelPropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemAccessibleLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ListItemAccessibleLabelPropertyInfo = (~) T.Text
    type AttrTransferType ListItemAccessibleLabelPropertyInfo = T.Text
    type AttrGetType ListItemAccessibleLabelPropertyInfo = T.Text
    type AttrLabel ListItemAccessibleLabelPropertyInfo = "accessible-label"
    type AttrOrigin ListItemAccessibleLabelPropertyInfo = ListItem
    attrGet = getListItemAccessibleLabel
    attrSet = setListItemAccessibleLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructListItemAccessibleLabel
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.accessibleLabel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:accessibleLabel"
        })
#endif

-- VVV Prop "activatable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@activatable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #activatable
-- @
getListItemActivatable :: (MonadIO m, IsListItem o) => o -> m Bool
getListItemActivatable :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Bool
getListItemActivatable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"activatable"

-- | Set the value of the “@activatable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' listItem [ #activatable 'Data.GI.Base.Attributes.:=' value ]
-- @
setListItemActivatable :: (MonadIO m, IsListItem o) => o -> Bool -> m ()
setListItemActivatable :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> Bool -> m ()
setListItemActivatable o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"activatable" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@activatable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListItemActivatable :: (IsListItem o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructListItemActivatable :: forall o (m :: * -> *).
(IsListItem o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructListItemActivatable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"activatable" Bool
val

#if defined(ENABLE_OVERLOADING)
data ListItemActivatablePropertyInfo
instance AttrInfo ListItemActivatablePropertyInfo where
    type AttrAllowedOps ListItemActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ListItemActivatablePropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemActivatablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ListItemActivatablePropertyInfo = (~) Bool
    type AttrTransferType ListItemActivatablePropertyInfo = Bool
    type AttrGetType ListItemActivatablePropertyInfo = Bool
    type AttrLabel ListItemActivatablePropertyInfo = "activatable"
    type AttrOrigin ListItemActivatablePropertyInfo = ListItem
    attrGet = getListItemActivatable
    attrSet = setListItemActivatable
    attrTransfer _ v = do
        return v
    attrConstruct = constructListItemActivatable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.activatable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:activatable"
        })
#endif

-- VVV Prop "child"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Widget"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #child
-- @
getListItemChild :: (MonadIO m, IsListItem o) => o -> m (Maybe Gtk.Widget.Widget)
getListItemChild :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> m (Maybe Widget)
getListItemChild o
obj = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Widget -> Widget) -> IO (Maybe Widget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"child" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Set the value of the “@child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' listItem [ #child 'Data.GI.Base.Attributes.:=' value ]
-- @
setListItemChild :: (MonadIO m, IsListItem o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setListItemChild :: forall (m :: * -> *) o a.
(MonadIO m, IsListItem o, IsWidget a) =>
o -> a -> m ()
setListItemChild o
obj a
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 -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"child" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@child@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListItemChild :: (IsListItem o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructListItemChild :: forall o (m :: * -> *) a.
(IsListItem o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructListItemChild a
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 -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@child@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #child
-- @
clearListItemChild :: (MonadIO m, IsListItem o) => o -> m ()
clearListItemChild :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m ()
clearListItemChild o
obj = 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
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"child" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data ListItemChildPropertyInfo
instance AttrInfo ListItemChildPropertyInfo where
    type AttrAllowedOps ListItemChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ListItemChildPropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint ListItemChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType ListItemChildPropertyInfo = Gtk.Widget.Widget
    type AttrGetType ListItemChildPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel ListItemChildPropertyInfo = "child"
    type AttrOrigin ListItemChildPropertyInfo = ListItem
    attrGet = getListItemChild
    attrSet = setListItemChild
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructListItemChild
    attrClear = clearListItemChild
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.child"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:child"
        })
#endif

-- VVV Prop "focusable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@focusable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #focusable
-- @
getListItemFocusable :: (MonadIO m, IsListItem o) => o -> m Bool
getListItemFocusable :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Bool
getListItemFocusable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"focusable"

-- | Set the value of the “@focusable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' listItem [ #focusable 'Data.GI.Base.Attributes.:=' value ]
-- @
setListItemFocusable :: (MonadIO m, IsListItem o) => o -> Bool -> m ()
setListItemFocusable :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> Bool -> m ()
setListItemFocusable o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"focusable" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@focusable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListItemFocusable :: (IsListItem o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructListItemFocusable :: forall o (m :: * -> *).
(IsListItem o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructListItemFocusable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"focusable" Bool
val

#if defined(ENABLE_OVERLOADING)
data ListItemFocusablePropertyInfo
instance AttrInfo ListItemFocusablePropertyInfo where
    type AttrAllowedOps ListItemFocusablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ListItemFocusablePropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemFocusablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ListItemFocusablePropertyInfo = (~) Bool
    type AttrTransferType ListItemFocusablePropertyInfo = Bool
    type AttrGetType ListItemFocusablePropertyInfo = Bool
    type AttrLabel ListItemFocusablePropertyInfo = "focusable"
    type AttrOrigin ListItemFocusablePropertyInfo = ListItem
    attrGet = getListItemFocusable
    attrSet = setListItemFocusable
    attrTransfer _ v = do
        return v
    attrConstruct = constructListItemFocusable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.focusable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:focusable"
        })
#endif

-- VVV Prop "item"
   -- Type: TInterface (Name {namespace = "GObject", name = "Object"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@item@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #item
-- @
getListItemItem :: (MonadIO m, IsListItem o) => o -> m (Maybe GObject.Object.Object)
getListItemItem :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> m (Maybe Object)
getListItemItem o
obj = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Object -> Object) -> IO (Maybe Object)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"item" ManagedPtr Object -> Object
GObject.Object.Object

#if defined(ENABLE_OVERLOADING)
data ListItemItemPropertyInfo
instance AttrInfo ListItemItemPropertyInfo where
    type AttrAllowedOps ListItemItemPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ListItemItemPropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemItemPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ListItemItemPropertyInfo = (~) ()
    type AttrTransferType ListItemItemPropertyInfo = ()
    type AttrGetType ListItemItemPropertyInfo = (Maybe GObject.Object.Object)
    type AttrLabel ListItemItemPropertyInfo = "item"
    type AttrOrigin ListItemItemPropertyInfo = ListItem
    attrGet = getListItemItem
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.item"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:item"
        })
#endif

-- VVV Prop "position"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@position@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #position
-- @
getListItemPosition :: (MonadIO m, IsListItem o) => o -> m Word32
getListItemPosition :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Word32
getListItemPosition o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"position"

#if defined(ENABLE_OVERLOADING)
data ListItemPositionPropertyInfo
instance AttrInfo ListItemPositionPropertyInfo where
    type AttrAllowedOps ListItemPositionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ListItemPositionPropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemPositionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ListItemPositionPropertyInfo = (~) ()
    type AttrTransferType ListItemPositionPropertyInfo = ()
    type AttrGetType ListItemPositionPropertyInfo = Word32
    type AttrLabel ListItemPositionPropertyInfo = "position"
    type AttrOrigin ListItemPositionPropertyInfo = ListItem
    attrGet = getListItemPosition
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.position"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:position"
        })
#endif

-- VVV Prop "selectable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@selectable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #selectable
-- @
getListItemSelectable :: (MonadIO m, IsListItem o) => o -> m Bool
getListItemSelectable :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Bool
getListItemSelectable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"selectable"

-- | Set the value of the “@selectable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' listItem [ #selectable 'Data.GI.Base.Attributes.:=' value ]
-- @
setListItemSelectable :: (MonadIO m, IsListItem o) => o -> Bool -> m ()
setListItemSelectable :: forall (m :: * -> *) o.
(MonadIO m, IsListItem o) =>
o -> Bool -> m ()
setListItemSelectable o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"selectable" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@selectable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListItemSelectable :: (IsListItem o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructListItemSelectable :: forall o (m :: * -> *).
(IsListItem o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructListItemSelectable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"selectable" Bool
val

#if defined(ENABLE_OVERLOADING)
data ListItemSelectablePropertyInfo
instance AttrInfo ListItemSelectablePropertyInfo where
    type AttrAllowedOps ListItemSelectablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ListItemSelectablePropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemSelectablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ListItemSelectablePropertyInfo = (~) Bool
    type AttrTransferType ListItemSelectablePropertyInfo = Bool
    type AttrGetType ListItemSelectablePropertyInfo = Bool
    type AttrLabel ListItemSelectablePropertyInfo = "selectable"
    type AttrOrigin ListItemSelectablePropertyInfo = ListItem
    attrGet = getListItemSelectable
    attrSet = setListItemSelectable
    attrTransfer _ v = do
        return v
    attrConstruct = constructListItemSelectable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.selectable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:selectable"
        })
#endif

-- VVV Prop "selected"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@selected@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listItem #selected
-- @
getListItemSelected :: (MonadIO m, IsListItem o) => o -> m Bool
getListItemSelected :: forall (m :: * -> *) o. (MonadIO m, IsListItem o) => o -> m Bool
getListItemSelected o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"selected"

#if defined(ENABLE_OVERLOADING)
data ListItemSelectedPropertyInfo
instance AttrInfo ListItemSelectedPropertyInfo where
    type AttrAllowedOps ListItemSelectedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ListItemSelectedPropertyInfo = IsListItem
    type AttrSetTypeConstraint ListItemSelectedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ListItemSelectedPropertyInfo = (~) ()
    type AttrTransferType ListItemSelectedPropertyInfo = ()
    type AttrGetType ListItemSelectedPropertyInfo = Bool
    type AttrLabel ListItemSelectedPropertyInfo = "selected"
    type AttrOrigin ListItemSelectedPropertyInfo = ListItem
    attrGet = getListItemSelected
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.selected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#g:attr:selected"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ListItem
type instance O.AttributeList ListItem = ListItemAttributeList
type ListItemAttributeList = ('[ '("accessibleDescription", ListItemAccessibleDescriptionPropertyInfo), '("accessibleLabel", ListItemAccessibleLabelPropertyInfo), '("activatable", ListItemActivatablePropertyInfo), '("child", ListItemChildPropertyInfo), '("focusable", ListItemFocusablePropertyInfo), '("item", ListItemItemPropertyInfo), '("position", ListItemPositionPropertyInfo), '("selectable", ListItemSelectablePropertyInfo), '("selected", ListItemSelectedPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
listItemAccessibleDescription :: AttrLabelProxy "accessibleDescription"
listItemAccessibleDescription = AttrLabelProxy

listItemAccessibleLabel :: AttrLabelProxy "accessibleLabel"
listItemAccessibleLabel = AttrLabelProxy

listItemActivatable :: AttrLabelProxy "activatable"
listItemActivatable = AttrLabelProxy

listItemChild :: AttrLabelProxy "child"
listItemChild = AttrLabelProxy

listItemFocusable :: AttrLabelProxy "focusable"
listItemFocusable = AttrLabelProxy

listItemItem :: AttrLabelProxy "item"
listItemItem = AttrLabelProxy

listItemPosition :: AttrLabelProxy "position"
listItemPosition = AttrLabelProxy

listItemSelectable :: AttrLabelProxy "selectable"
listItemSelectable = AttrLabelProxy

listItemSelected :: AttrLabelProxy "selected"
listItemSelected = AttrLabelProxy

#endif

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

#endif

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

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

-- | Gets the accessible description of /@self@/.
-- 
-- /Since: 4.12/
listItemGetAccessibleDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m T.Text
    -- ^ __Returns:__ the accessible description
listItemGetAccessibleDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Text
listItemGetAccessibleDescription a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ListItem -> IO CString
gtk_list_item_get_accessible_description Ptr ListItem
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"listItemGetAccessibleDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ListItemGetAccessibleDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetAccessibleDescriptionMethodInfo a signature where
    overloadedMethod = listItemGetAccessibleDescription

instance O.OverloadedMethodInfo ListItemGetAccessibleDescriptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetAccessibleDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetAccessibleDescription"
        })


#endif

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

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

-- | Gets the accessible label of /@self@/.
-- 
-- /Since: 4.12/
listItemGetAccessibleLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m T.Text
    -- ^ __Returns:__ the accessible label
listItemGetAccessibleLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Text
listItemGetAccessibleLabel a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ListItem -> IO CString
gtk_list_item_get_accessible_label Ptr ListItem
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"listItemGetAccessibleLabel" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ListItemGetAccessibleLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetAccessibleLabelMethodInfo a signature where
    overloadedMethod = listItemGetAccessibleLabel

instance O.OverloadedMethodInfo ListItemGetAccessibleLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetAccessibleLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetAccessibleLabel"
        })


#endif

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

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

-- | Checks if a list item has been set to be activatable via
-- 'GI.Gtk.Objects.ListItem.listItemSetActivatable'.
listItemGetActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the item is activatable
listItemGetActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Bool
listItemGetActivatable a
self = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ListItem -> IO CInt
gtk_list_item_get_activatable Ptr ListItem
self'
    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 ListItemGetActivatableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetActivatableMethodInfo a signature where
    overloadedMethod = listItemGetActivatable

instance O.OverloadedMethodInfo ListItemGetActivatableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetActivatable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetActivatable"
        })


#endif

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

foreign import ccall "gtk_list_item_get_child" gtk_list_item_get_child :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the child previously set via 'GI.Gtk.Objects.ListItem.listItemSetChild' or
-- 'P.Nothing' if none was set.
listItemGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ The child
listItemGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m (Maybe Widget)
listItemGetChild a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr ListItem -> IO (Ptr Widget)
gtk_list_item_get_child Ptr ListItem
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data ListItemGetChildMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetChildMethodInfo a signature where
    overloadedMethod = listItemGetChild

instance O.OverloadedMethodInfo ListItemGetChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetChild"
        })


#endif

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

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

-- | Checks if a list item has been set to be focusable via
-- 'GI.Gtk.Objects.ListItem.listItemSetFocusable'.
-- 
-- /Since: 4.12/
listItemGetFocusable ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the item is focusable
listItemGetFocusable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Bool
listItemGetFocusable a
self = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ListItem -> IO CInt
gtk_list_item_get_focusable Ptr ListItem
self'
    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 ListItemGetFocusableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetFocusableMethodInfo a signature where
    overloadedMethod = listItemGetFocusable

instance O.OverloadedMethodInfo ListItemGetFocusableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetFocusable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetFocusable"
        })


#endif

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

foreign import ccall "gtk_list_item_get_item" gtk_list_item_get_item :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    IO (Ptr GObject.Object.Object)

-- | Gets the model item that associated with /@self@/.
-- 
-- If /@self@/ is unbound, this function returns 'P.Nothing'.
listItemGetItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m (Maybe GObject.Object.Object)
    -- ^ __Returns:__ The item displayed
listItemGetItem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m (Maybe Object)
listItemGetItem a
self = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
result <- Ptr ListItem -> IO (Ptr Object)
gtk_list_item_get_item Ptr ListItem
self'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result'
        Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data ListItemGetItemMethodInfo
instance (signature ~ (m (Maybe GObject.Object.Object)), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetItemMethodInfo a signature where
    overloadedMethod = listItemGetItem

instance O.OverloadedMethodInfo ListItemGetItemMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetItem",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetItem"
        })


#endif

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

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

-- | Gets the position in the model that /@self@/ currently displays.
-- 
-- If /@self@/ is unbound, 'GI.Gtk.Constants.INVALID_LIST_POSITION' is returned.
listItemGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m Word32
    -- ^ __Returns:__ The position of this item
listItemGetPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Word32
listItemGetPosition a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr ListItem -> IO Word32
gtk_list_item_get_position Ptr ListItem
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ListItemGetPositionMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetPositionMethodInfo a signature where
    overloadedMethod = listItemGetPosition

instance O.OverloadedMethodInfo ListItemGetPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetPosition"
        })


#endif

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

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

-- | Checks if a list item has been set to be selectable via
-- 'GI.Gtk.Objects.ListItem.listItemSetSelectable'.
-- 
-- Do not confuse this function with 'GI.Gtk.Objects.ListItem.listItemGetSelected'.
listItemGetSelectable ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the item is selectable
listItemGetSelectable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Bool
listItemGetSelectable a
self = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ListItem -> IO CInt
gtk_list_item_get_selectable Ptr ListItem
self'
    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 ListItemGetSelectableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetSelectableMethodInfo a signature where
    overloadedMethod = listItemGetSelectable

instance O.OverloadedMethodInfo ListItemGetSelectableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetSelectable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetSelectable"
        })


#endif

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

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

-- | Checks if the item is displayed as selected.
-- 
-- The selected state is maintained by the liste widget and its model
-- and cannot be set otherwise.
listItemGetSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the item is selected.
listItemGetSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> m Bool
listItemGetSelected a
self = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ListItem -> IO CInt
gtk_list_item_get_selected Ptr ListItem
self'
    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 ListItemGetSelectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemGetSelectedMethodInfo a signature where
    overloadedMethod = listItemGetSelected

instance O.OverloadedMethodInfo ListItemGetSelectedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemGetSelected",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemGetSelected"
        })


#endif

-- method ListItem::set_accessible_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkListItem`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the description" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_item_set_accessible_description" gtk_list_item_set_accessible_description :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    CString ->                              -- description : TBasicType TUTF8
    IO ()

-- | Sets the accessible description for the list item,
-- which may be used by e.g. screen readers.
-- 
-- /Since: 4.12/
listItemSetAccessibleDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> T.Text
    -- ^ /@description@/: the description
    -> m ()
listItemSetAccessibleDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> Text -> m ()
listItemSetAccessibleDescription a
self Text
description = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
description' <- Text -> IO CString
textToCString Text
description
    Ptr ListItem -> CString -> IO ()
gtk_list_item_set_accessible_description Ptr ListItem
self' CString
description'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListItemSetAccessibleDescriptionMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemSetAccessibleDescriptionMethodInfo a signature where
    overloadedMethod = listItemSetAccessibleDescription

instance O.OverloadedMethodInfo ListItemSetAccessibleDescriptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemSetAccessibleDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemSetAccessibleDescription"
        })


#endif

-- method ListItem::set_accessible_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkListItem`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the label" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_item_set_accessible_label" gtk_list_item_set_accessible_label :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    CString ->                              -- label : TBasicType TUTF8
    IO ()

-- | Sets the accessible label for the list item,
-- which may be used by e.g. screen readers.
-- 
-- /Since: 4.12/
listItemSetAccessibleLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> T.Text
    -- ^ /@label@/: the label
    -> m ()
listItemSetAccessibleLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> Text -> m ()
listItemSetAccessibleLabel a
self Text
label = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
label' <- Text -> IO CString
textToCString Text
label
    Ptr ListItem -> CString -> IO ()
gtk_list_item_set_accessible_label Ptr ListItem
self' CString
label'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListItemSetAccessibleLabelMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemSetAccessibleLabelMethodInfo a signature where
    overloadedMethod = listItemSetAccessibleLabel

instance O.OverloadedMethodInfo ListItemSetAccessibleLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemSetAccessibleLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemSetAccessibleLabel"
        })


#endif

-- method ListItem::set_activatable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkListItem`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "activatable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if the item should be activatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_item_set_activatable" gtk_list_item_set_activatable :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    CInt ->                                 -- activatable : TBasicType TBoolean
    IO ()

-- | Sets /@self@/ to be activatable.
-- 
-- If an item is activatable, double-clicking on the item, using
-- the Return key or calling 'GI.Gtk.Objects.Widget.widgetActivate' will activate
-- the item. Activating instructs the containing view to handle
-- activation. @GtkListView@ for example will be emitting the
-- [ListView::activate]("GI.Gtk.Objects.ListView#g:signal:activate") signal.
-- 
-- By default, list items are activatable.
listItemSetActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> Bool
    -- ^ /@activatable@/: if the item should be activatable
    -> m ()
listItemSetActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> Bool -> m ()
listItemSetActivatable a
self Bool
activatable = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let activatable' :: CInt
activatable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
activatable
    Ptr ListItem -> CInt -> IO ()
gtk_list_item_set_activatable Ptr ListItem
self' CInt
activatable'
    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 ListItemSetActivatableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemSetActivatableMethodInfo a signature where
    overloadedMethod = listItemSetActivatable

instance O.OverloadedMethodInfo ListItemSetActivatableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemSetActivatable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemSetActivatable"
        })


#endif

-- method ListItem::set_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkListItem`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The list item's child or %NULL to unset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_item_set_child" gtk_list_item_set_child :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the child to be used for this listitem.
-- 
-- This function is typically called by applications when
-- setting up a listitem so that the widget can be reused when
-- binding it multiple times.
listItemSetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> Maybe (b)
    -- ^ /@child@/: The list item\'s child or 'P.Nothing' to unset
    -> m ()
listItemSetChild :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListItem a, IsWidget b) =>
a -> Maybe b -> m ()
listItemSetChild a
self Maybe b
child = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeChild <- case Maybe b
child of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jChild -> do
            Ptr Widget
jChild' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jChild'
    Ptr ListItem -> Ptr Widget -> IO ()
gtk_list_item_set_child Ptr ListItem
self' Ptr Widget
maybeChild
    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
child 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 ListItemSetChildMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsListItem a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ListItemSetChildMethodInfo a signature where
    overloadedMethod = listItemSetChild

instance O.OverloadedMethodInfo ListItemSetChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemSetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemSetChild"
        })


#endif

-- method ListItem::set_focusable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkListItem`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "focusable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if the item should be focusable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_item_set_focusable" gtk_list_item_set_focusable :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    CInt ->                                 -- focusable : TBasicType TBoolean
    IO ()

-- | Sets /@self@/ to be focusable.
-- 
-- If an item is focusable, it can be focused using the keyboard.
-- This works similar to 'GI.Gtk.Objects.Widget.widgetSetFocusable'.
-- 
-- Note that if items are not focusable, the keyboard cannot be used to activate
-- them and selecting only works if one of the listitem\'s children is focusable.
-- 
-- By default, list items are focusable.
-- 
-- /Since: 4.12/
listItemSetFocusable ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> Bool
    -- ^ /@focusable@/: if the item should be focusable
    -> m ()
listItemSetFocusable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> Bool -> m ()
listItemSetFocusable a
self Bool
focusable = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let focusable' :: CInt
focusable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
focusable
    Ptr ListItem -> CInt -> IO ()
gtk_list_item_set_focusable Ptr ListItem
self' CInt
focusable'
    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 ListItemSetFocusableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemSetFocusableMethodInfo a signature where
    overloadedMethod = listItemSetFocusable

instance O.OverloadedMethodInfo ListItemSetFocusableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemSetFocusable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemSetFocusable"
        })


#endif

-- method ListItem::set_selectable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkListItem`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selectable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if the item should be selectable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_item_set_selectable" gtk_list_item_set_selectable :: 
    Ptr ListItem ->                         -- self : TInterface (Name {namespace = "Gtk", name = "ListItem"})
    CInt ->                                 -- selectable : TBasicType TBoolean
    IO ()

-- | Sets /@self@/ to be selectable.
-- 
-- If an item is selectable, clicking on the item or using the keyboard
-- will try to select or unselect the item. If this succeeds is up to
-- the model to determine, as it is managing the selected state.
-- 
-- Note that this means that making an item non-selectable has no
-- influence on the selected state at all. A non-selectable item
-- may still be selected.
-- 
-- By default, list items are selectable. When rebinding them to
-- a new item, they will also be reset to be selectable by GTK.
listItemSetSelectable ::
    (B.CallStack.HasCallStack, MonadIO m, IsListItem a) =>
    a
    -- ^ /@self@/: a @GtkListItem@
    -> Bool
    -- ^ /@selectable@/: if the item should be selectable
    -> m ()
listItemSetSelectable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItem a) =>
a -> Bool -> m ()
listItemSetSelectable a
self Bool
selectable = 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 ListItem
self' <- a -> IO (Ptr ListItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let selectable' :: CInt
selectable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
selectable
    Ptr ListItem -> CInt -> IO ()
gtk_list_item_set_selectable Ptr ListItem
self' CInt
selectable'
    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 ListItemSetSelectableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsListItem a) => O.OverloadedMethod ListItemSetSelectableMethodInfo a signature where
    overloadedMethod = listItemSetSelectable

instance O.OverloadedMethodInfo ListItemSetSelectableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ListItem.listItemSetSelectable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ListItem.html#v:listItemSetSelectable"
        })


#endif