{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkSingleSelection is an implementation of the t'GI.Gtk.Interfaces.SelectionModel.SelectionModel' interface
-- that allows selecting a single element. It is the default selection method
-- used by list widgets in GTK.
-- 
-- Note that the selection is *persistent* -- if the selected item is removed
-- and re-added in the same [itemsChanged]("GI.Gio.Interfaces.ListModel#g:signal:itemsChanged") emission, it stays selected.
-- In particular, this means that changing the sort order of an underlying sort
-- model will preserve the selection.

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

module GI.Gtk.Objects.SingleSelection
    ( 

-- * Exported types
    SingleSelection(..)                     ,
    IsSingleSelection                       ,
    toSingleSelection                       ,


 -- * 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
-- [getAutoselect]("GI.Gtk.Objects.SingleSelection#g:method:getAutoselect"), [getCanUnselect]("GI.Gtk.Objects.SingleSelection#g:method:getCanUnselect"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getModel]("GI.Gtk.Objects.SingleSelection#g:method:getModel"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelected]("GI.Gtk.Objects.SingleSelection#g:method:getSelected"), [getSelectedItem]("GI.Gtk.Objects.SingleSelection#g:method:getSelectedItem"), [getSelection]("GI.Gtk.Interfaces.SelectionModel#g:method:getSelection"), [getSelectionInRange]("GI.Gtk.Interfaces.SelectionModel#g:method:getSelectionInRange").
-- 
-- ==== Setters
-- [setAutoselect]("GI.Gtk.Objects.SingleSelection#g:method:setAutoselect"), [setCanUnselect]("GI.Gtk.Objects.SingleSelection#g:method:setCanUnselect"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setModel]("GI.Gtk.Objects.SingleSelection#g:method:setModel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSelected]("GI.Gtk.Objects.SingleSelection#g:method:setSelected"), [setSelection]("GI.Gtk.Interfaces.SelectionModel#g:method:setSelection").

#if defined(ENABLE_OVERLOADING)
    ResolveSingleSelectionMethod            ,
#endif

-- ** getAutoselect #method:getAutoselect#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionGetAutoselectMethodInfo  ,
#endif
    singleSelectionGetAutoselect            ,


-- ** getCanUnselect #method:getCanUnselect#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionGetCanUnselectMethodInfo ,
#endif
    singleSelectionGetCanUnselect           ,


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionGetModelMethodInfo       ,
#endif
    singleSelectionGetModel                 ,


-- ** getSelected #method:getSelected#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionGetSelectedMethodInfo    ,
#endif
    singleSelectionGetSelected              ,


-- ** getSelectedItem #method:getSelectedItem#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionGetSelectedItemMethodInfo,
#endif
    singleSelectionGetSelectedItem          ,


-- ** new #method:new#

    singleSelectionNew                      ,


-- ** setAutoselect #method:setAutoselect#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionSetAutoselectMethodInfo  ,
#endif
    singleSelectionSetAutoselect            ,


-- ** setCanUnselect #method:setCanUnselect#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionSetCanUnselectMethodInfo ,
#endif
    singleSelectionSetCanUnselect           ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionSetModelMethodInfo       ,
#endif
    singleSelectionSetModel                 ,


-- ** setSelected #method:setSelected#

#if defined(ENABLE_OVERLOADING)
    SingleSelectionSetSelectedMethodInfo    ,
#endif
    singleSelectionSetSelected              ,




 -- * Properties


-- ** autoselect #attr:autoselect#
-- | If the selection will always select an item

#if defined(ENABLE_OVERLOADING)
    SingleSelectionAutoselectPropertyInfo   ,
#endif
    constructSingleSelectionAutoselect      ,
    getSingleSelectionAutoselect            ,
    setSingleSelectionAutoselect            ,
#if defined(ENABLE_OVERLOADING)
    singleSelectionAutoselect               ,
#endif


-- ** canUnselect #attr:canUnselect#
-- | If unselecting the selected item is allowed

#if defined(ENABLE_OVERLOADING)
    SingleSelectionCanUnselectPropertyInfo  ,
#endif
    constructSingleSelectionCanUnselect     ,
    getSingleSelectionCanUnselect           ,
    setSingleSelectionCanUnselect           ,
#if defined(ENABLE_OVERLOADING)
    singleSelectionCanUnselect              ,
#endif


-- ** model #attr:model#
-- | The model being managed

#if defined(ENABLE_OVERLOADING)
    SingleSelectionModelPropertyInfo        ,
#endif
    clearSingleSelectionModel               ,
    constructSingleSelectionModel           ,
    getSingleSelectionModel                 ,
    setSingleSelectionModel                 ,
#if defined(ENABLE_OVERLOADING)
    singleSelectionModel                    ,
#endif


-- ** selected #attr:selected#
-- | Position of the selected item

#if defined(ENABLE_OVERLOADING)
    SingleSelectionSelectedPropertyInfo     ,
#endif
    constructSingleSelectionSelected        ,
    getSingleSelectionSelected              ,
    setSingleSelectionSelected              ,
#if defined(ENABLE_OVERLOADING)
    singleSelectionSelected                 ,
#endif


-- ** selectedItem #attr:selectedItem#
-- | The selected item

#if defined(ENABLE_OVERLOADING)
    SingleSelectionSelectedItemPropertyInfo ,
#endif
    getSingleSelectionSelectedItem          ,
#if defined(ENABLE_OVERLOADING)
    singleSelectionSelectedItem             ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.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.Interfaces.SelectionModel as Gtk.SelectionModel

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

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

foreign import ccall "gtk_single_selection_get_type"
    c_gtk_single_selection_get_type :: IO B.Types.GType

instance B.Types.TypedObject SingleSelection where
    glibType :: IO GType
glibType = IO GType
c_gtk_single_selection_get_type

instance B.Types.GObject SingleSelection

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

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

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

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

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

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

#endif

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data SingleSelectionAutoselectPropertyInfo
instance AttrInfo SingleSelectionAutoselectPropertyInfo where
    type AttrAllowedOps SingleSelectionAutoselectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SingleSelectionAutoselectPropertyInfo = IsSingleSelection
    type AttrSetTypeConstraint SingleSelectionAutoselectPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SingleSelectionAutoselectPropertyInfo = (~) Bool
    type AttrTransferType SingleSelectionAutoselectPropertyInfo = Bool
    type AttrGetType SingleSelectionAutoselectPropertyInfo = Bool
    type AttrLabel SingleSelectionAutoselectPropertyInfo = "autoselect"
    type AttrOrigin SingleSelectionAutoselectPropertyInfo = SingleSelection
    attrGet = getSingleSelectionAutoselect
    attrSet = setSingleSelectionAutoselect
    attrTransfer _ v = do
        return v
    attrConstruct = constructSingleSelectionAutoselect
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data SingleSelectionCanUnselectPropertyInfo
instance AttrInfo SingleSelectionCanUnselectPropertyInfo where
    type AttrAllowedOps SingleSelectionCanUnselectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SingleSelectionCanUnselectPropertyInfo = IsSingleSelection
    type AttrSetTypeConstraint SingleSelectionCanUnselectPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SingleSelectionCanUnselectPropertyInfo = (~) Bool
    type AttrTransferType SingleSelectionCanUnselectPropertyInfo = Bool
    type AttrGetType SingleSelectionCanUnselectPropertyInfo = Bool
    type AttrLabel SingleSelectionCanUnselectPropertyInfo = "can-unselect"
    type AttrOrigin SingleSelectionCanUnselectPropertyInfo = SingleSelection
    attrGet = getSingleSelectionCanUnselect
    attrSet = setSingleSelectionCanUnselect
    attrTransfer _ v = do
        return v
    attrConstruct = constructSingleSelectionCanUnselect
    attrClear = undefined
#endif

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Gio", name = "ListModel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

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

-- | Set the value of the “@model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' singleSelection [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setSingleSelectionModel :: (MonadIO m, IsSingleSelection o, Gio.ListModel.IsListModel a) => o -> a -> m ()
setSingleSelectionModel :: forall (m :: * -> *) o a.
(MonadIO m, IsSingleSelection o, IsListModel a) =>
o -> a -> m ()
setSingleSelectionModel o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@model@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSingleSelectionModel :: (IsSingleSelection o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructSingleSelectionModel :: forall o (m :: * -> *) a.
(IsSingleSelection o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructSingleSelectionModel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"model" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@model@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #model
-- @
clearSingleSelectionModel :: (MonadIO m, IsSingleSelection o) => o -> m ()
clearSingleSelectionModel :: forall (m :: * -> *) o.
(MonadIO m, IsSingleSelection o) =>
o -> m ()
clearSingleSelectionModel o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ListModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (Maybe ListModel
forall a. Maybe a
Nothing :: Maybe Gio.ListModel.ListModel)

#if defined(ENABLE_OVERLOADING)
data SingleSelectionModelPropertyInfo
instance AttrInfo SingleSelectionModelPropertyInfo where
    type AttrAllowedOps SingleSelectionModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SingleSelectionModelPropertyInfo = IsSingleSelection
    type AttrSetTypeConstraint SingleSelectionModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint SingleSelectionModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType SingleSelectionModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType SingleSelectionModelPropertyInfo = Gio.ListModel.ListModel
    type AttrLabel SingleSelectionModelPropertyInfo = "model"
    type AttrOrigin SingleSelectionModelPropertyInfo = SingleSelection
    attrGet = getSingleSelectionModel
    attrSet = setSingleSelectionModel
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructSingleSelectionModel
    attrClear = clearSingleSelectionModel
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data SingleSelectionSelectedPropertyInfo
instance AttrInfo SingleSelectionSelectedPropertyInfo where
    type AttrAllowedOps SingleSelectionSelectedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SingleSelectionSelectedPropertyInfo = IsSingleSelection
    type AttrSetTypeConstraint SingleSelectionSelectedPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SingleSelectionSelectedPropertyInfo = (~) Word32
    type AttrTransferType SingleSelectionSelectedPropertyInfo = Word32
    type AttrGetType SingleSelectionSelectedPropertyInfo = Word32
    type AttrLabel SingleSelectionSelectedPropertyInfo = "selected"
    type AttrOrigin SingleSelectionSelectedPropertyInfo = SingleSelection
    attrGet = getSingleSelectionSelected
    attrSet = setSingleSelectionSelected
    attrTransfer _ v = do
        return v
    attrConstruct = constructSingleSelectionSelected
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data SingleSelectionSelectedItemPropertyInfo
instance AttrInfo SingleSelectionSelectedItemPropertyInfo where
    type AttrAllowedOps SingleSelectionSelectedItemPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SingleSelectionSelectedItemPropertyInfo = IsSingleSelection
    type AttrSetTypeConstraint SingleSelectionSelectedItemPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SingleSelectionSelectedItemPropertyInfo = (~) ()
    type AttrTransferType SingleSelectionSelectedItemPropertyInfo = ()
    type AttrGetType SingleSelectionSelectedItemPropertyInfo = (Maybe GObject.Object.Object)
    type AttrLabel SingleSelectionSelectedItemPropertyInfo = "selected-item"
    type AttrOrigin SingleSelectionSelectedItemPropertyInfo = SingleSelection
    attrGet = getSingleSelectionSelectedItem
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SingleSelection
type instance O.AttributeList SingleSelection = SingleSelectionAttributeList
type SingleSelectionAttributeList = ('[ '("autoselect", SingleSelectionAutoselectPropertyInfo), '("canUnselect", SingleSelectionCanUnselectPropertyInfo), '("model", SingleSelectionModelPropertyInfo), '("selected", SingleSelectionSelectedPropertyInfo), '("selectedItem", SingleSelectionSelectedItemPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
singleSelectionAutoselect :: AttrLabelProxy "autoselect"
singleSelectionAutoselect = AttrLabelProxy

singleSelectionCanUnselect :: AttrLabelProxy "canUnselect"
singleSelectionCanUnselect = AttrLabelProxy

singleSelectionModel :: AttrLabelProxy "model"
singleSelectionModel = AttrLabelProxy

singleSelectionSelected :: AttrLabelProxy "selected"
singleSelectionSelected = AttrLabelProxy

singleSelectionSelectedItem :: AttrLabelProxy "selectedItem"
singleSelectionSelectedItem = AttrLabelProxy

#endif

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

#endif

-- method SingleSelection::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GListModel to manage, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "SingleSelection" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_single_selection_new" gtk_single_selection_new :: 
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO (Ptr SingleSelection)

-- | Creates a new selection to handle /@model@/.
singleSelectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    Maybe (a)
    -- ^ /@model@/: the t'GI.Gio.Interfaces.ListModel.ListModel' to manage, or 'P.Nothing'
    -> m SingleSelection
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.SingleSelection.SingleSelection'
singleSelectionNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
Maybe a -> m SingleSelection
singleSelectionNew Maybe a
model = IO SingleSelection -> m SingleSelection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SingleSelection -> m SingleSelection)
-> IO SingleSelection -> m SingleSelection
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListModel
maybeModel <- case Maybe a
model of
        Maybe a
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just a
jModel -> do
            Ptr ListModel
jModel' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr SingleSelection
result <- Ptr ListModel -> IO (Ptr SingleSelection)
gtk_single_selection_new Ptr ListModel
maybeModel
    Text -> Ptr SingleSelection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"singleSelectionNew" Ptr SingleSelection
result
    SingleSelection
result' <- ((ManagedPtr SingleSelection -> SingleSelection)
-> Ptr SingleSelection -> IO SingleSelection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SingleSelection -> SingleSelection
SingleSelection) Ptr SingleSelection
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
model a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    SingleSelection -> IO SingleSelection
forall (m :: * -> *) a. Monad m => a -> m a
return SingleSelection
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SingleSelection::get_autoselect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SingleSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSingleSelection"
--                 , 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_single_selection_get_autoselect" gtk_single_selection_get_autoselect :: 
    Ptr SingleSelection ->                  -- self : TInterface (Name {namespace = "Gtk", name = "SingleSelection"})
    IO CInt

-- | Checks if autoselect has been enabled or disabled via
-- 'GI.Gtk.Objects.SingleSelection.singleSelectionSetAutoselect'.
singleSelectionGetAutoselect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if autoselect is enabled
singleSelectionGetAutoselect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> m Bool
singleSelectionGetAutoselect a
self = 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 SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr SingleSelection -> IO CInt
gtk_single_selection_get_autoselect Ptr SingleSelection
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SingleSelectionGetAutoselectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionGetAutoselectMethodInfo a signature where
    overloadedMethod = singleSelectionGetAutoselect

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


#endif

-- method SingleSelection::get_can_unselect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SingleSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSingleSelection"
--                 , 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_single_selection_get_can_unselect" gtk_single_selection_get_can_unselect :: 
    Ptr SingleSelection ->                  -- self : TInterface (Name {namespace = "Gtk", name = "SingleSelection"})
    IO CInt

-- | If 'P.True', 'GI.Gtk.Interfaces.SelectionModel.selectionModelUnselectItem' is supported and allows
-- unselecting the selected item.
singleSelectionGetCanUnselect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> m Bool
    -- ^ __Returns:__ 'P.True' to support unselecting
singleSelectionGetCanUnselect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> m Bool
singleSelectionGetCanUnselect a
self = 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 SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr SingleSelection -> IO CInt
gtk_single_selection_get_can_unselect Ptr SingleSelection
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SingleSelectionGetCanUnselectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionGetCanUnselectMethodInfo a signature where
    overloadedMethod = singleSelectionGetCanUnselect

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


#endif

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

foreign import ccall "gtk_single_selection_get_model" gtk_single_selection_get_model :: 
    Ptr SingleSelection ->                  -- self : TInterface (Name {namespace = "Gtk", name = "SingleSelection"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the model that /@self@/ is wrapping.
singleSelectionGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ The model being wrapped
singleSelectionGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> m ListModel
singleSelectionGetModel a
self = IO ListModel -> m ListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr SingleSelection -> IO (Ptr ListModel)
gtk_single_selection_get_model Ptr SingleSelection
self'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"singleSelectionGetModel" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ListModel -> IO ListModel
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
data SingleSelectionGetModelMethodInfo
instance (signature ~ (m Gio.ListModel.ListModel), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionGetModelMethodInfo a signature where
    overloadedMethod = singleSelectionGetModel

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


#endif

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

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

-- | Gets the position of the selected item. If no item is selected,
-- @/GTK_INVALID_LIST_POSITION/@ is returned.
singleSelectionGetSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> m Word32
    -- ^ __Returns:__ The position of the selected item
singleSelectionGetSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> m Word32
singleSelectionGetSelected a
self = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr SingleSelection -> IO Word32
gtk_single_selection_get_selected Ptr SingleSelection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SingleSelectionGetSelectedMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionGetSelectedMethodInfo a signature where
    overloadedMethod = singleSelectionGetSelected

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


#endif

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

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

-- | Gets the selected item.
-- 
-- If no item is selected, 'P.Nothing' is returned.
singleSelectionGetSelectedItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> m (Ptr ())
    -- ^ __Returns:__ The selected item
singleSelectionGetSelectedItem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> m (Ptr ())
singleSelectionGetSelectedItem a
self = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ()
result <- Ptr SingleSelection -> IO (Ptr ())
gtk_single_selection_get_selected_item Ptr SingleSelection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data SingleSelectionGetSelectedItemMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionGetSelectedItemMethodInfo a signature where
    overloadedMethod = singleSelectionGetSelectedItem

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


#endif

-- method SingleSelection::set_autoselect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SingleSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSingleSelection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "autoselect"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to always select an item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | If /@autoselect@/ is 'P.True', /@self@/ will enforce that an item is always
-- selected. It will select a new item when the currently selected
-- item is deleted and it will disallow unselecting the current item.
singleSelectionSetAutoselect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> Bool
    -- ^ /@autoselect@/: 'P.True' to always select an item
    -> m ()
singleSelectionSetAutoselect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> Bool -> m ()
singleSelectionSetAutoselect a
self Bool
autoselect = 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 SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let autoselect' :: CInt
autoselect' = (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
autoselect
    Ptr SingleSelection -> CInt -> IO ()
gtk_single_selection_set_autoselect Ptr SingleSelection
self' CInt
autoselect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SingleSelectionSetAutoselectMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionSetAutoselectMethodInfo a signature where
    overloadedMethod = singleSelectionSetAutoselect

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


#endif

-- method SingleSelection::set_can_unselect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SingleSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSingleSelection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "can_unselect"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to allow unselecting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | If 'P.True', unselecting the current item via
-- 'GI.Gtk.Interfaces.SelectionModel.selectionModelUnselectItem' is supported.
-- 
-- Note that setting t'GI.Gtk.Objects.SingleSelection.SingleSelection':@/autoselect/@ will cause the
-- unselecting to not work, so it practically makes no sense to set
-- both at the same time the same time.
singleSelectionSetCanUnselect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> Bool
    -- ^ /@canUnselect@/: 'P.True' to allow unselecting
    -> m ()
singleSelectionSetCanUnselect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> Bool -> m ()
singleSelectionSetCanUnselect a
self Bool
canUnselect = 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 SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let canUnselect' :: CInt
canUnselect' = (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
canUnselect
    Ptr SingleSelection -> CInt -> IO ()
gtk_single_selection_set_can_unselect Ptr SingleSelection
self' CInt
canUnselect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SingleSelectionSetCanUnselectMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionSetCanUnselectMethodInfo a signature where
    overloadedMethod = singleSelectionSetCanUnselect

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


#endif

-- method SingleSelection::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SingleSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSingleSelection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GListModel to wrap"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_single_selection_set_model" gtk_single_selection_set_model :: 
    Ptr SingleSelection ->                  -- self : TInterface (Name {namespace = "Gtk", name = "SingleSelection"})
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | Sets the model that /@self@/ should wrap. If /@model@/ is 'P.Nothing', /@self@/
-- will be empty.
singleSelectionSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> Maybe (b)
    -- ^ /@model@/: A t'GI.Gio.Interfaces.ListModel.ListModel' to wrap
    -> m ()
singleSelectionSetModel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSingleSelection a, IsListModel b) =>
a -> Maybe b -> m ()
singleSelectionSetModel a
self Maybe b
model = 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 SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
maybeModel <- case Maybe b
model of
        Maybe b
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just b
jModel -> do
            Ptr ListModel
jModel' <- b -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr SingleSelection -> Ptr ListModel -> IO ()
gtk_single_selection_set_model Ptr SingleSelection
self' Ptr ListModel
maybeModel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
model b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SingleSelectionSetModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSingleSelection a, Gio.ListModel.IsListModel b) => O.OverloadedMethod SingleSelectionSetModelMethodInfo a signature where
    overloadedMethod = singleSelectionSetModel

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


#endif

-- method SingleSelection::set_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SingleSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSingleSelection"
--                 , 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 item to select or #GTK_INVALID_LIST_POSITION"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_single_selection_set_selected" gtk_single_selection_set_selected :: 
    Ptr SingleSelection ->                  -- self : TInterface (Name {namespace = "Gtk", name = "SingleSelection"})
    Word32 ->                               -- position : TBasicType TUInt
    IO ()

-- | Selects the item at the given position.
-- 
-- If the list does not have an item at /@position@/ or
-- @/GTK_INVALID_LIST_POSITION/@ is given, the behavior depends on the
-- value of the t'GI.Gtk.Objects.SingleSelection.SingleSelection':@/autoselect/@ property: If it is set,
-- no change will occur and the old item will stay selected. If it is
-- unset, the selection will be unset and no item will be selected.
singleSelectionSetSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsSingleSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SingleSelection.SingleSelection'
    -> Word32
    -- ^ /@position@/: the item to select or @/GTK_INVALID_LIST_POSITION/@
    -> m ()
singleSelectionSetSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSingleSelection a) =>
a -> Word32 -> m ()
singleSelectionSetSelected a
self Word32
position = 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 SingleSelection
self' <- a -> IO (Ptr SingleSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SingleSelection -> Word32 -> IO ()
gtk_single_selection_set_selected Ptr SingleSelection
self' Word32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SingleSelectionSetSelectedMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSingleSelection a) => O.OverloadedMethod SingleSelectionSetSelectedMethodInfo a signature where
    overloadedMethod = singleSelectionSetSelected

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


#endif