{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Interfaces.SelectionModel.SelectionModel' is an interface that extends the t'GI.Gio.Interfaces.ListModel.ListModel' interface by
-- adding support for selections. This support is then used by widgets using list
-- models to add the ability to select and unselect various items.
-- 
-- GTK provides default implementations of the most common selection modes such
-- as t'GI.Gtk.Objects.SingleSelection.SingleSelection', so you will only need to implement this interface if
-- you want detailed control about how selections should be handled.
-- 
-- A t'GI.Gtk.Interfaces.SelectionModel.SelectionModel' supports a single boolean per item indicating if an item
-- is selected or not. This can be queried via 'GI.Gtk.Interfaces.SelectionModel.selectionModelIsSelected'.
-- When the selected state of one or more items changes, the model will emit the
-- [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#g:signal:selectionChanged") signal by calling the
-- 'GI.Gtk.Interfaces.SelectionModel.selectionModelSelectionChanged' function. The positions given in that
-- signal may have their selection state changed, though that is not a requirement.
-- If new items added to the model via the [itemsChanged]("GI.Gio.Interfaces.ListModel#g:signal:itemsChanged") signal are
-- selected or not is up to the implementation.
-- 
-- Note that items added via [itemsChanged]("GI.Gio.Interfaces.ListModel#g:signal:itemsChanged") may already be selected
-- and no [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#g:signal:selectionChanged") will be emitted for them. So to
-- track which items are selected, it is necessary to listen to both signals.
-- 
-- Additionally, the interface can expose functionality to select and unselect
-- items. If these functions are implemented, GTK\'s list widgets will allow users
-- to select and unselect items. However, @/GtkSelectionModels/@ are free to only
-- implement them partially or not at all. In that case the widgets will not
-- support the unimplemented operations.
-- 
-- When selecting or unselecting is supported by a model, the return values of
-- the selection functions do *not* indicate if selection or unselection happened.
-- They are only meant to indicate complete failure, like when this mode of
-- selecting is not supported by the model.
-- 
-- Selections may happen asynchronously, so the only reliable way to find out
-- when an item was selected is to listen to the signals that indicate selection.

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

module GI.Gtk.Interfaces.SelectionModel
    ( 

-- * Exported types
    SelectionModel(..)                      ,
    IsSelectionModel                        ,
    toSelectionModel                        ,


 -- * 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"), [isSelected]("GI.Gtk.Interfaces.SelectionModel#g:method:isSelected"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [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"), [selectAll]("GI.Gtk.Interfaces.SelectionModel#g:method:selectAll"), [selectItem]("GI.Gtk.Interfaces.SelectionModel#g:method:selectItem"), [selectRange]("GI.Gtk.Interfaces.SelectionModel#g:method:selectRange"), [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#g:method:selectionChanged"), [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"), [unselectAll]("GI.Gtk.Interfaces.SelectionModel#g:method:unselectAll"), [unselectItem]("GI.Gtk.Interfaces.SelectionModel#g:method:unselectItem"), [unselectRange]("GI.Gtk.Interfaces.SelectionModel#g:method:unselectRange"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelection]("GI.Gtk.Interfaces.SelectionModel#g:method:getSelection"), [getSelectionInRange]("GI.Gtk.Interfaces.SelectionModel#g:method:getSelectionInRange").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSelection]("GI.Gtk.Interfaces.SelectionModel#g:method:setSelection").

#if defined(ENABLE_OVERLOADING)
    ResolveSelectionModelMethod             ,
#endif

-- ** getSelection #method:getSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionModelGetSelectionMethodInfo    ,
#endif
    selectionModelGetSelection              ,


-- ** getSelectionInRange #method:getSelectionInRange#

#if defined(ENABLE_OVERLOADING)
    SelectionModelGetSelectionInRangeMethodInfo,
#endif
    selectionModelGetSelectionInRange       ,


-- ** isSelected #method:isSelected#

#if defined(ENABLE_OVERLOADING)
    SelectionModelIsSelectedMethodInfo      ,
#endif
    selectionModelIsSelected                ,


-- ** selectAll #method:selectAll#

#if defined(ENABLE_OVERLOADING)
    SelectionModelSelectAllMethodInfo       ,
#endif
    selectionModelSelectAll                 ,


-- ** selectItem #method:selectItem#

#if defined(ENABLE_OVERLOADING)
    SelectionModelSelectItemMethodInfo      ,
#endif
    selectionModelSelectItem                ,


-- ** selectRange #method:selectRange#

#if defined(ENABLE_OVERLOADING)
    SelectionModelSelectRangeMethodInfo     ,
#endif
    selectionModelSelectRange               ,


-- ** selectionChanged #method:selectionChanged#

#if defined(ENABLE_OVERLOADING)
    SelectionModelSelectionChangedMethodInfo,
#endif
    selectionModelSelectionChanged          ,


-- ** setSelection #method:setSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionModelSetSelectionMethodInfo    ,
#endif
    selectionModelSetSelection              ,


-- ** unselectAll #method:unselectAll#

#if defined(ENABLE_OVERLOADING)
    SelectionModelUnselectAllMethodInfo     ,
#endif
    selectionModelUnselectAll               ,


-- ** unselectItem #method:unselectItem#

#if defined(ENABLE_OVERLOADING)
    SelectionModelUnselectItemMethodInfo    ,
#endif
    selectionModelUnselectItem              ,


-- ** unselectRange #method:unselectRange#

#if defined(ENABLE_OVERLOADING)
    SelectionModelUnselectRangeMethodInfo   ,
#endif
    selectionModelUnselectRange             ,




 -- * Signals


-- ** selectionChanged #signal:selectionChanged#

    C_SelectionModelSelectionChangedCallback,
    SelectionModelSelectionChangedCallback  ,
#if defined(ENABLE_OVERLOADING)
    SelectionModelSelectionChangedSignalInfo,
#endif
    afterSelectionModelSelectionChanged     ,
    genClosure_SelectionModelSelectionChanged,
    mk_SelectionModelSelectionChangedCallback,
    noSelectionModelSelectionChangedCallback,
    onSelectionModelSelectionChanged        ,
    wrap_SelectionModelSelectionChangedCallback,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import {-# SOURCE #-} qualified GI.Gtk.Structs.Bitset as Gtk.Bitset

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

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

foreign import ccall "gtk_selection_model_get_type"
    c_gtk_selection_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject SelectionModel where
    glibType :: IO GType
glibType = IO GType
c_gtk_selection_model_get_type

instance B.Types.GObject SelectionModel

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

instance O.HasParentTypes SelectionModel
type instance O.ParentTypes SelectionModel = '[Gio.ListModel.ListModel, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SelectionModel
type instance O.AttributeList SelectionModel = SelectionModelAttributeList
type SelectionModelAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSelectionModelMethod (t :: Symbol) (o :: *) :: * where
    ResolveSelectionModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSelectionModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSelectionModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSelectionModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSelectionModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSelectionModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSelectionModelMethod "isSelected" o = SelectionModelIsSelectedMethodInfo
    ResolveSelectionModelMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveSelectionModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSelectionModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSelectionModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSelectionModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSelectionModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSelectionModelMethod "selectAll" o = SelectionModelSelectAllMethodInfo
    ResolveSelectionModelMethod "selectItem" o = SelectionModelSelectItemMethodInfo
    ResolveSelectionModelMethod "selectRange" o = SelectionModelSelectRangeMethodInfo
    ResolveSelectionModelMethod "selectionChanged" o = SelectionModelSelectionChangedMethodInfo
    ResolveSelectionModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSelectionModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSelectionModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSelectionModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSelectionModelMethod "unselectAll" o = SelectionModelUnselectAllMethodInfo
    ResolveSelectionModelMethod "unselectItem" o = SelectionModelUnselectItemMethodInfo
    ResolveSelectionModelMethod "unselectRange" o = SelectionModelUnselectRangeMethodInfo
    ResolveSelectionModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSelectionModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSelectionModelMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveSelectionModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveSelectionModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveSelectionModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSelectionModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSelectionModelMethod "getSelection" o = SelectionModelGetSelectionMethodInfo
    ResolveSelectionModelMethod "getSelectionInRange" o = SelectionModelGetSelectionInRangeMethodInfo
    ResolveSelectionModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSelectionModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSelectionModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSelectionModelMethod "setSelection" o = SelectionModelSetSelectionMethodInfo
    ResolveSelectionModelMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

foreign import ccall "gtk_selection_model_get_selection" gtk_selection_model_get_selection :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    IO (Ptr Gtk.Bitset.Bitset)

-- | Gets the set containing all currently selected items in the model.
-- 
-- This function may be slow, so if you are only interested in single item,
-- consider using 'GI.Gtk.Interfaces.SelectionModel.selectionModelIsSelected' or if you are only
-- interested in a few consider 'GI.Gtk.Interfaces.SelectionModel.selectionModelGetSelectionInRange'.
selectionModelGetSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> m Gtk.Bitset.Bitset
    -- ^ __Returns:__ a t'GI.Gtk.Structs.Bitset.Bitset' containing all the values currently
    --     selected in /@model@/. If no items are selected, the bitset is empty.
    --     The bitset must not be modified.
selectionModelGetSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> m Bitset
selectionModelGetSelection a
model = IO Bitset -> m Bitset
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bitset -> m Bitset) -> IO Bitset -> m Bitset
forall a b. (a -> b) -> a -> b
$ do
    Ptr SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Bitset
result <- Ptr SelectionModel -> IO (Ptr Bitset)
gtk_selection_model_get_selection Ptr SelectionModel
model'
    Text -> Ptr Bitset -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"selectionModelGetSelection" Ptr Bitset
result
    Bitset
result' <- ((ManagedPtr Bitset -> Bitset) -> Ptr Bitset -> IO Bitset
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bitset -> Bitset
Gtk.Bitset.Bitset) Ptr Bitset
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Bitset -> IO Bitset
forall (m :: * -> *) a. Monad m => a -> m a
return Bitset
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelGetSelectionMethodInfo
instance (signature ~ (m Gtk.Bitset.Bitset), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelGetSelectionMethodInfo a signature where
    overloadedMethod = selectionModelGetSelection

instance O.OverloadedMethodInfo SelectionModelGetSelectionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelGetSelection",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelGetSelection"
        }


#endif

-- method SelectionModel::get_selection_in_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of the queired range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_items"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of items in the queried range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Bitset" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_get_selection_in_range" gtk_selection_model_get_selection_in_range :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    Word32 ->                               -- n_items : TBasicType TUInt
    IO (Ptr Gtk.Bitset.Bitset)

-- | Gets a set containing a set where the values in the range @[position,
-- position + n_items)@ match the selected state of the items in that range.
-- All values outside that range are undefined.
-- 
-- This function is an optimization for 'GI.Gtk.Interfaces.SelectionModel.selectionModelGetSelection' when
-- you are only interested in part of the model\'s selected state. A common use
-- case is in response to the [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#g:signal:selectionChanged") signal.
selectionModelGetSelectionInRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: start of the queired range
    -> Word32
    -- ^ /@nItems@/: number of items in the queried range
    -> m Gtk.Bitset.Bitset
    -- ^ __Returns:__ A t'GI.Gtk.Structs.Bitset.Bitset' that matches the selection state for the given state
    --     with all other values being undefined.
    --     The bitset must not be modified.
selectionModelGetSelectionInRange :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> Word32 -> m Bitset
selectionModelGetSelectionInRange a
model Word32
position Word32
nItems = IO Bitset -> m Bitset
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bitset -> m Bitset) -> IO Bitset -> m Bitset
forall a b. (a -> b) -> a -> b
$ do
    Ptr SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Bitset
result <- Ptr SelectionModel -> Word32 -> Word32 -> IO (Ptr Bitset)
gtk_selection_model_get_selection_in_range Ptr SelectionModel
model' Word32
position Word32
nItems
    Text -> Ptr Bitset -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"selectionModelGetSelectionInRange" Ptr Bitset
result
    Bitset
result' <- ((ManagedPtr Bitset -> Bitset) -> Ptr Bitset -> IO Bitset
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bitset -> Bitset
Gtk.Bitset.Bitset) Ptr Bitset
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Bitset -> IO Bitset
forall (m :: * -> *) a. Monad m => a -> m a
return Bitset
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelGetSelectionInRangeMethodInfo
instance (signature ~ (Word32 -> Word32 -> m Gtk.Bitset.Bitset), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelGetSelectionInRangeMethodInfo a signature where
    overloadedMethod = selectionModelGetSelectionInRange

instance O.OverloadedMethodInfo SelectionModelGetSelectionInRangeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelGetSelectionInRange",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelGetSelectionInRange"
        }


#endif

-- method SelectionModel::is_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the item to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_is_selected" gtk_selection_model_is_selected :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    IO CInt

-- | Checks if the given item is selected.
selectionModelIsSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the position of the item to query
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the item is selected
selectionModelIsSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> m Bool
selectionModelIsSelected a
model Word32
position = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr SelectionModel -> Word32 -> IO CInt
gtk_selection_model_is_selected Ptr SelectionModel
model' Word32
position
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelIsSelectedMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelIsSelectedMethodInfo a signature where
    overloadedMethod = selectionModelIsSelected

instance O.OverloadedMethodInfo SelectionModelIsSelectedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelIsSelected",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelIsSelected"
        }


#endif

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

foreign import ccall "gtk_selection_model_select_all" gtk_selection_model_select_all :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    IO CInt

-- | Requests to select all items in the model.
selectionModelSelectAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean that all items are now selected.
selectionModelSelectAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> m Bool
selectionModelSelectAll a
model = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr SelectionModel -> IO CInt
gtk_selection_model_select_all Ptr SelectionModel
model'
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelSelectAllMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelSelectAllMethodInfo a signature where
    overloadedMethod = selectionModelSelectAll

instance O.OverloadedMethodInfo SelectionModelSelectAllMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelSelectAll",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelSelectAll"
        }


#endif

-- method SelectionModel::select_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the item to select"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unselect_rest"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether previously selected items should be unselected"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_select_item" gtk_selection_model_select_item :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    CInt ->                                 -- unselect_rest : TBasicType TBoolean
    IO CInt

-- | Requests to select an item in the model.
selectionModelSelectItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the position of the item to select
    -> Bool
    -- ^ /@unselectRest@/: whether previously selected items should be unselected
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean the item was selected.
selectionModelSelectItem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> Bool -> m Bool
selectionModelSelectItem a
model Word32
position Bool
unselectRest = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    let unselectRest' :: CInt
unselectRest' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
unselectRest
    CInt
result <- Ptr SelectionModel -> Word32 -> CInt -> IO CInt
gtk_selection_model_select_item Ptr SelectionModel
model' Word32
position CInt
unselectRest'
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelSelectItemMethodInfo
instance (signature ~ (Word32 -> Bool -> m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelSelectItemMethodInfo a signature where
    overloadedMethod = selectionModelSelectItem

instance O.OverloadedMethodInfo SelectionModelSelectItemMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelSelectItem",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelSelectItem"
        }


#endif

-- method SelectionModel::select_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first item to select"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_items"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of items to select"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unselect_rest"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether previously selected items should be unselected"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_select_range" gtk_selection_model_select_range :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    Word32 ->                               -- n_items : TBasicType TUInt
    CInt ->                                 -- unselect_rest : TBasicType TBoolean
    IO CInt

-- | Requests to select a range of items in the model.
selectionModelSelectRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the first item to select
    -> Word32
    -- ^ /@nItems@/: the number of items to select
    -> Bool
    -- ^ /@unselectRest@/: whether previously selected items should be unselected
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean the range was selected.
selectionModelSelectRange :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> Word32 -> Bool -> m Bool
selectionModelSelectRange a
model Word32
position Word32
nItems Bool
unselectRest = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    let unselectRest' :: CInt
unselectRest' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
unselectRest
    CInt
result <- Ptr SelectionModel -> Word32 -> Word32 -> CInt -> IO CInt
gtk_selection_model_select_range Ptr SelectionModel
model' Word32
position Word32
nItems CInt
unselectRest'
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelSelectRangeMethodInfo
instance (signature ~ (Word32 -> Word32 -> Bool -> m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelSelectRangeMethodInfo a signature where
    overloadedMethod = selectionModelSelectRange

instance O.OverloadedMethodInfo SelectionModelSelectRangeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelSelectRange",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelSelectRange"
        }


#endif

-- method SelectionModel::selection_changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first changed item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_items"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of changed items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_selection_changed" gtk_selection_model_selection_changed :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    Word32 ->                               -- n_items : TBasicType TUInt
    IO ()

-- | Helper function for implementations of t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'.
-- Call this when a the selection changes to emit the
-- [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#g:signal:selectionChanged") signal.
selectionModelSelectionChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the first changed item
    -> Word32
    -- ^ /@nItems@/: the number of changed items
    -> m ()
selectionModelSelectionChanged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> Word32 -> m ()
selectionModelSelectionChanged a
model Word32
position Word32
nItems = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr SelectionModel -> Word32 -> Word32 -> IO ()
gtk_selection_model_selection_changed Ptr SelectionModel
model' Word32
position Word32
nItems
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SelectionModelSelectionChangedMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelSelectionChangedMethodInfo a signature where
    overloadedMethod = selectionModelSelectionChanged

instance O.OverloadedMethodInfo SelectionModelSelectionChangedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelSelectionChanged",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelSelectionChanged"
        }


#endif

-- method SelectionModel::set_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selected"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Bitset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "bitmask specifying if items should be selected or\n    unselected"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mask"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Bitset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "bitmask specifying which items should be updated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_set_selection" gtk_selection_model_set_selection :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Ptr Gtk.Bitset.Bitset ->                -- selected : TInterface (Name {namespace = "Gtk", name = "Bitset"})
    Ptr Gtk.Bitset.Bitset ->                -- mask : TInterface (Name {namespace = "Gtk", name = "Bitset"})
    IO CInt

-- | This is the most advanced selection updating method that allows
-- the most fine-grained control over selection changes.
-- If you can, you should try the simpler versions, as implementations
-- are more likely to implement support for those.
-- 
-- Requests that the selection state of all positions set in /@mask@/ be
-- updated to the respective value in the /@selected@/ bitmask.
-- 
-- In pseudocode, it would look something like this:
-- 
-- 
-- === /C code/
-- >
-- >for (i = 0; i < n_items; i++)
-- >  {
-- >    // don't change values not in the mask
-- >    if (!gtk_bitset_contains (mask, i))
-- >      continue;
-- >
-- >    if (gtk_bitset_contains (selected, i))
-- >      select_item (i);
-- >    else
-- >      unselect_item (i);
-- >  }
-- >
-- >gtk_selection_model_selection_changed (model, first_changed_item, n_changed_items);
-- 
-- 
-- /@mask@/ and /@selected@/ must not be modified. They may refer to the same bitset,
-- which would mean that every item in the set should be selected.
selectionModelSetSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Gtk.Bitset.Bitset
    -- ^ /@selected@/: bitmask specifying if items should be selected or
    --     unselected
    -> Gtk.Bitset.Bitset
    -- ^ /@mask@/: bitmask specifying which items should be updated
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean that all items were updated according
    --     to the inputs.
selectionModelSetSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Bitset -> Bitset -> m Bool
selectionModelSetSelection a
model Bitset
selected Bitset
mask = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Bitset
selected' <- Bitset -> IO (Ptr Bitset)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bitset
selected
    Ptr Bitset
mask' <- Bitset -> IO (Ptr Bitset)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bitset
mask
    CInt
result <- Ptr SelectionModel -> Ptr Bitset -> Ptr Bitset -> IO CInt
gtk_selection_model_set_selection Ptr SelectionModel
model' Ptr Bitset
selected' Ptr Bitset
mask'
    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
model
    Bitset -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bitset
selected
    Bitset -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bitset
mask
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelSetSelectionMethodInfo
instance (signature ~ (Gtk.Bitset.Bitset -> Gtk.Bitset.Bitset -> m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelSetSelectionMethodInfo a signature where
    overloadedMethod = selectionModelSetSelection

instance O.OverloadedMethodInfo SelectionModelSetSelectionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelSetSelection",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelSetSelection"
        }


#endif

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

foreign import ccall "gtk_selection_model_unselect_all" gtk_selection_model_unselect_all :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    IO CInt

-- | Requests to unselect all items in the model.
selectionModelUnselectAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean that all items are now unselected.
selectionModelUnselectAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> m Bool
selectionModelUnselectAll a
model = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr SelectionModel -> IO CInt
gtk_selection_model_unselect_all Ptr SelectionModel
model'
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelUnselectAllMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelUnselectAllMethodInfo a signature where
    overloadedMethod = selectionModelUnselectAll

instance O.OverloadedMethodInfo SelectionModelUnselectAllMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelUnselectAll",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelUnselectAll"
        }


#endif

-- method SelectionModel::unselect_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the item to unselect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_unselect_item" gtk_selection_model_unselect_item :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    IO CInt

-- | Requests to unselect an item in the model.
selectionModelUnselectItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the position of the item to unselect
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean the item was unselected.
selectionModelUnselectItem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> m Bool
selectionModelUnselectItem a
model Word32
position = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr SelectionModel -> Word32 -> IO CInt
gtk_selection_model_unselect_item Ptr SelectionModel
model' Word32
position
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelUnselectItemMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelUnselectItemMethodInfo a signature where
    overloadedMethod = selectionModelUnselectItem

instance O.OverloadedMethodInfo SelectionModelUnselectItemMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelUnselectItem",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelUnselectItem"
        }


#endif

-- method SelectionModel::unselect_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSelectionModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first item to unselect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_items"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of items to unselect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_selection_model_unselect_range" gtk_selection_model_unselect_range :: 
    Ptr SelectionModel ->                   -- model : TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
    Word32 ->                               -- position : TBasicType TUInt
    Word32 ->                               -- n_items : TBasicType TUInt
    IO CInt

-- | Requests to unselect a range of items in the model.
selectionModelUnselectRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the first item to unselect
    -> Word32
    -- ^ /@nItems@/: the number of items to unselect
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was supported and no fallback should be
    --     tried. This does not mean the range was unselected.
selectionModelUnselectRange :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
a -> Word32 -> Word32 -> m Bool
selectionModelUnselectRange a
model Word32
position Word32
nItems = IO Bool -> m Bool
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 SelectionModel
model' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr SelectionModel -> Word32 -> Word32 -> IO CInt
gtk_selection_model_unselect_range Ptr SelectionModel
model' Word32
position Word32
nItems
    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
model
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionModelUnselectRangeMethodInfo
instance (signature ~ (Word32 -> Word32 -> m Bool), MonadIO m, IsSelectionModel a) => O.OverloadedMethod SelectionModelUnselectRangeMethodInfo a signature where
    overloadedMethod = selectionModelUnselectRange

instance O.OverloadedMethodInfo SelectionModelUnselectRangeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Interfaces.SelectionModel.selectionModelUnselectRange",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Interfaces-SelectionModel.html#v:selectionModelUnselectRange"
        }


#endif

-- signal SelectionModel::selection-changed
-- | Emitted when the selection state of some of the items in /@model@/ changes.
-- 
-- Note that this signal does not specify the new selection state of the items,
-- they need to be queried manually.
-- It is also not necessary for a model to change the selection state of any of
-- the items in the selection model, though it would be rather useless to emit
-- such a signal.
type SelectionModelSelectionChangedCallback =
    Word32
    -- ^ /@position@/: The first item that may have changed
    -> Word32
    -- ^ /@nItems@/: number of items with changes
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SelectionModelSelectionChangedCallback`@.
noSelectionModelSelectionChangedCallback :: Maybe SelectionModelSelectionChangedCallback
noSelectionModelSelectionChangedCallback :: Maybe (Word32 -> Word32 -> IO ())
noSelectionModelSelectionChangedCallback = Maybe (Word32 -> Word32 -> IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_SelectionModelSelectionChangedCallback =
    Ptr () ->                               -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_SelectionModelSelectionChangedCallback`.
foreign import ccall "wrapper"
    mk_SelectionModelSelectionChangedCallback :: C_SelectionModelSelectionChangedCallback -> IO (FunPtr C_SelectionModelSelectionChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_SelectionModelSelectionChanged :: MonadIO m => SelectionModelSelectionChangedCallback -> m (GClosure C_SelectionModelSelectionChangedCallback)
genClosure_SelectionModelSelectionChanged :: forall (m :: * -> *).
MonadIO m =>
(Word32 -> Word32 -> IO ())
-> m (GClosure C_SelectionModelSelectionChangedCallback)
genClosure_SelectionModelSelectionChanged Word32 -> Word32 -> IO ()
cb = IO (GClosure C_SelectionModelSelectionChangedCallback)
-> m (GClosure C_SelectionModelSelectionChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SelectionModelSelectionChangedCallback)
 -> m (GClosure C_SelectionModelSelectionChangedCallback))
-> IO (GClosure C_SelectionModelSelectionChangedCallback)
-> m (GClosure C_SelectionModelSelectionChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_SelectionModelSelectionChangedCallback
cb' = (Word32 -> Word32 -> IO ())
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback Word32 -> Word32 -> IO ()
cb
    C_SelectionModelSelectionChangedCallback
-> IO (FunPtr C_SelectionModelSelectionChangedCallback)
mk_SelectionModelSelectionChangedCallback C_SelectionModelSelectionChangedCallback
cb' IO (FunPtr C_SelectionModelSelectionChangedCallback)
-> (FunPtr C_SelectionModelSelectionChangedCallback
    -> IO (GClosure C_SelectionModelSelectionChangedCallback))
-> IO (GClosure C_SelectionModelSelectionChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SelectionModelSelectionChangedCallback
-> IO (GClosure C_SelectionModelSelectionChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SelectionModelSelectionChangedCallback` into a `C_SelectionModelSelectionChangedCallback`.
wrap_SelectionModelSelectionChangedCallback ::
    SelectionModelSelectionChangedCallback ->
    C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback :: (Word32 -> Word32 -> IO ())
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback Word32 -> Word32 -> IO ()
_cb Ptr ()
_ Word32
position Word32
nItems Ptr ()
_ = do
    Word32 -> Word32 -> IO ()
_cb  Word32
position Word32
nItems


-- | Connect a signal handler for the [selectionChanged](#signal:selectionChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' selectionModel #selectionChanged callback
-- @
-- 
-- 
onSelectionModelSelectionChanged :: (IsSelectionModel a, MonadIO m) => a -> SelectionModelSelectionChangedCallback -> m SignalHandlerId
onSelectionModelSelectionChanged :: forall a (m :: * -> *).
(IsSelectionModel a, MonadIO m) =>
a -> (Word32 -> Word32 -> IO ()) -> m SignalHandlerId
onSelectionModelSelectionChanged a
obj Word32 -> Word32 -> IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_SelectionModelSelectionChangedCallback
cb' = (Word32 -> Word32 -> IO ())
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback Word32 -> Word32 -> IO ()
cb
    FunPtr C_SelectionModelSelectionChangedCallback
cb'' <- C_SelectionModelSelectionChangedCallback
-> IO (FunPtr C_SelectionModelSelectionChangedCallback)
mk_SelectionModelSelectionChangedCallback C_SelectionModelSelectionChangedCallback
cb'
    a
-> Text
-> FunPtr C_SelectionModelSelectionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"selection-changed" FunPtr C_SelectionModelSelectionChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [selectionChanged](#signal:selectionChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' selectionModel #selectionChanged callback
-- @
-- 
-- 
afterSelectionModelSelectionChanged :: (IsSelectionModel a, MonadIO m) => a -> SelectionModelSelectionChangedCallback -> m SignalHandlerId
afterSelectionModelSelectionChanged :: forall a (m :: * -> *).
(IsSelectionModel a, MonadIO m) =>
a -> (Word32 -> Word32 -> IO ()) -> m SignalHandlerId
afterSelectionModelSelectionChanged a
obj Word32 -> Word32 -> IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_SelectionModelSelectionChangedCallback
cb' = (Word32 -> Word32 -> IO ())
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback Word32 -> Word32 -> IO ()
cb
    FunPtr C_SelectionModelSelectionChangedCallback
cb'' <- C_SelectionModelSelectionChangedCallback
-> IO (FunPtr C_SelectionModelSelectionChangedCallback)
mk_SelectionModelSelectionChangedCallback C_SelectionModelSelectionChangedCallback
cb'
    a
-> Text
-> FunPtr C_SelectionModelSelectionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"selection-changed" FunPtr C_SelectionModelSelectionChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SelectionModelSelectionChangedSignalInfo
instance SignalInfo SelectionModelSelectionChangedSignalInfo where
    type HaskellCallbackType SelectionModelSelectionChangedSignalInfo = SelectionModelSelectionChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SelectionModelSelectionChangedCallback cb
        cb'' <- mk_SelectionModelSelectionChangedCallback cb'
        connectSignalFunPtr obj "selection-changed" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SelectionModel = SelectionModelSignalList
type SelectionModelSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("selectionChanged", SelectionModelSelectionChangedSignalInfo)] :: [(Symbol, *)])

#endif