{-# 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 mode 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 row indicating if a row is selected
-- or not. This can be queried via 'GI.Gtk.Interfaces.SelectionModel.selectionModelIsSelected'. When the selected
-- state of one or more rows changes, the model will emit the
-- [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#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#signal:itemsChanged") signal are selected
-- or not is up to the implementation.
-- 
-- 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(..)                      ,
    noSelectionModel                        ,
    IsSelectionModel                        ,
    toSelectionModel                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSelectionModelMethod             ,
#endif


-- ** isSelected #method:isSelected#

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


-- ** queryRange #method:queryRange#

#if defined(ENABLE_OVERLOADING)
    SelectionModelQueryRangeMethodInfo      ,
#endif
    selectionModelQueryRange                ,


-- ** 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          ,


-- ** 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel

-- interface SelectionModel 
-- | Memory-managed wrapper type.
newtype SelectionModel = SelectionModel (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)
-- | A convenience alias for `Nothing` :: `Maybe` `SelectionModel`.
noSelectionModel :: Maybe SelectionModel
noSelectionModel :: Maybe SelectionModel
noSelectionModel = Maybe SelectionModel
forall a. Maybe a
Nothing

-- 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 SelectionModelSelectionChangedCallback
noSelectionModelSelectionChangedCallback = Maybe SelectionModelSelectionChangedCallback
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 :: SelectionModelSelectionChangedCallback
-> m (GClosure C_SelectionModelSelectionChangedCallback)
genClosure_SelectionModelSelectionChanged cb :: SelectionModelSelectionChangedCallback
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' = SelectionModelSelectionChangedCallback
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback SelectionModelSelectionChangedCallback
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 :: SelectionModelSelectionChangedCallback
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback _cb :: SelectionModelSelectionChangedCallback
_cb _ position :: Word32
position nItems :: Word32
nItems _ = do
    SelectionModelSelectionChangedCallback
_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 :: a -> SelectionModelSelectionChangedCallback -> m SignalHandlerId
onSelectionModelSelectionChanged obj :: a
obj cb :: SelectionModelSelectionChangedCallback
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' = SelectionModelSelectionChangedCallback
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback SelectionModelSelectionChangedCallback
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 "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 :: a -> SelectionModelSelectionChangedCallback -> m SignalHandlerId
afterSelectionModelSelectionChanged obj :: a
obj cb :: SelectionModelSelectionChangedCallback
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' = SelectionModelSelectionChangedCallback
-> C_SelectionModelSelectionChangedCallback
wrap_SelectionModelSelectionChangedCallback SelectionModelSelectionChangedCallback
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 "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

foreign import ccall "gtk_selection_model_get_type"
    c_gtk_selection_model_get_type :: IO GType

instance GObject SelectionModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_selection_model_get_type
    

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

-- | Type class for types which can be safely cast to `SelectionModel`, for instance with `toSelectionModel`.
class (GObject o, O.IsDescendantOf SelectionModel o) => IsSelectionModel o
instance (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 :: (MonadIO m, IsSelectionModel o) => o -> m SelectionModel
toSelectionModel :: o -> m SelectionModel
toSelectionModel = IO SelectionModel -> m SelectionModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr SelectionModel -> SelectionModel
SelectionModel

#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 "queryRange" o = SelectionModelQueryRangeMethodInfo
    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 "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSelectionModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSelectionModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSelectionModelMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSelectionModelMethod t SelectionModel, O.MethodInfo 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

#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 :: a -> Word32 -> m Bool
selectionModelIsSelected model :: a
model position :: 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
/= 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.MethodInfo SelectionModelIsSelectedMethodInfo a signature where
    overloadedMethod = selectionModelIsSelected

#endif

-- method SelectionModel::query_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 position inside the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_range"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "returns the position of the first element of the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_items"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "returns the size of the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "selected"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "returns whether items in @range are selected"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | This function allows to query the selection status of multiple elements at once.
-- It is passed a position and returns a range of elements of uniform selection status.
-- 
-- If /@position@/ is greater than the number of items in /@model@/, /@nItems@/ is set to 0.
-- Otherwise the returned range is guaranteed to include the passed-in position, so
-- /@nItems@/ will be >= 1.
-- 
-- Positions directly adjacent to the returned range may have the same selection
-- status as the returned range.
-- 
-- This is an optimization function to make iterating over a model faster when few
-- items are selected. However, it is valid behavior for implementations to use a
-- naive implementation that only ever returns a single element.
selectionModelQueryRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionModel a) =>
    a
    -- ^ /@model@/: a t'GI.Gtk.Interfaces.SelectionModel.SelectionModel'
    -> Word32
    -- ^ /@position@/: the position inside the range
    -> m ((Word32, Word32, Bool))
selectionModelQueryRange :: a -> Word32 -> m (Word32, Word32, Bool)
selectionModelQueryRange model :: a
model position :: Word32
position = IO (Word32, Word32, Bool) -> m (Word32, Word32, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word32, Bool) -> m (Word32, Word32, Bool))
-> IO (Word32, Word32, Bool) -> m (Word32, Word32, 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 Word32
startRange <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
nItems <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr CInt
selected <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr SelectionModel
-> Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr CInt -> IO ()
gtk_selection_model_query_range Ptr SelectionModel
model' Word32
position Ptr Word32
startRange Ptr Word32
nItems Ptr CInt
selected
    Word32
startRange' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
startRange
    Word32
nItems' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nItems
    CInt
selected' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
selected
    let selected'' :: Bool
selected'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
selected'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
startRange
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nItems
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
selected
    (Word32, Word32, Bool) -> IO (Word32, Word32, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
startRange', Word32
nItems', Bool
selected'')

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

#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
selectionModelSelectAll :: a -> m Bool
selectionModelSelectAll model :: 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
/= 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.MethodInfo SelectionModelSelectAllMethodInfo a signature where
    overloadedMethod = 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 = "exclusive"
--           , 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 ->                                 -- exclusive : 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
    -- ^ /@exclusive@/: whether previously selected items should be unselected
    -> m Bool
selectionModelSelectItem :: a -> Word32 -> Bool -> m Bool
selectionModelSelectItem model :: a
model position :: Word32
position exclusive :: Bool
exclusive = 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 exclusive' :: CInt
exclusive' = (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
exclusive
    CInt
result <- Ptr SelectionModel -> Word32 -> CInt -> IO CInt
gtk_selection_model_select_item Ptr SelectionModel
model' Word32
position CInt
exclusive'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 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.MethodInfo SelectionModelSelectItemMethodInfo a signature where
    overloadedMethod = 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 = "exclusive"
--           , 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 ->                                 -- exclusive : 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
    -- ^ /@exclusive@/: whether previously selected items should be unselected
    -> m Bool
selectionModelSelectRange :: a -> Word32 -> Word32 -> Bool -> m Bool
selectionModelSelectRange model :: a
model position :: Word32
position nItems :: Word32
nItems exclusive :: Bool
exclusive = 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 exclusive' :: CInt
exclusive' = (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
exclusive
    CInt
result <- Ptr SelectionModel -> Word32 -> Word32 -> CInt -> IO CInt
gtk_selection_model_select_range Ptr SelectionModel
model' Word32
position Word32
nItems CInt
exclusive'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 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.MethodInfo SelectionModelSelectRangeMethodInfo a signature where
    overloadedMethod = 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](#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 :: a -> Word32 -> Word32 -> m ()
selectionModelSelectionChanged model :: a
model position :: Word32
position nItems :: 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 -> SelectionModelSelectionChangedCallback
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.MethodInfo SelectionModelSelectionChangedMethodInfo a signature where
    overloadedMethod = selectionModelSelectionChanged

#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
selectionModelUnselectAll :: a -> m Bool
selectionModelUnselectAll model :: 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
/= 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.MethodInfo SelectionModelUnselectAllMethodInfo a signature where
    overloadedMethod = 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
selectionModelUnselectItem :: a -> Word32 -> m Bool
selectionModelUnselectItem model :: a
model position :: 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
/= 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.MethodInfo SelectionModelUnselectItemMethodInfo a signature where
    overloadedMethod = 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
selectionModelUnselectRange :: a -> Word32 -> Word32 -> m Bool
selectionModelUnselectRange model :: a
model position :: Word32
position nItems :: 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
/= 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.MethodInfo SelectionModelUnselectRangeMethodInfo a signature where
    overloadedMethod = selectionModelUnselectRange

#endif