{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkNoSelection@ is a @GtkSelectionModel@ that does not allow selecting
-- anything.
-- 
-- This model is meant to be used as a simple wrapper around a @GListModel@
-- when a @GtkSelectionModel@ is required.

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

module GI.Gtk.Objects.NoSelection
    ( 

-- * Exported types
    NoSelection(..)                         ,
    IsNoSelection                           ,
    toNoSelection                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSelected]("GI.Gtk.Interfaces.SelectionModel#g:method:isSelected"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [selectAll]("GI.Gtk.Interfaces.SelectionModel#g:method:selectAll"), [selectItem]("GI.Gtk.Interfaces.SelectionModel#g:method:selectItem"), [selectRange]("GI.Gtk.Interfaces.SelectionModel#g:method:selectRange"), [selectionChanged]("GI.Gtk.Interfaces.SelectionModel#g:method:selectionChanged"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unselectAll]("GI.Gtk.Interfaces.SelectionModel#g:method:unselectAll"), [unselectItem]("GI.Gtk.Interfaces.SelectionModel#g:method:unselectItem"), [unselectRange]("GI.Gtk.Interfaces.SelectionModel#g:method:unselectRange"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getModel]("GI.Gtk.Objects.NoSelection#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"), [getSelection]("GI.Gtk.Interfaces.SelectionModel#g:method:getSelection"), [getSelectionInRange]("GI.Gtk.Interfaces.SelectionModel#g:method:getSelectionInRange").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setModel]("GI.Gtk.Objects.NoSelection#g:method:setModel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSelection]("GI.Gtk.Interfaces.SelectionModel#g:method:setSelection").

#if defined(ENABLE_OVERLOADING)
    ResolveNoSelectionMethod                ,
#endif

-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    NoSelectionGetModelMethodInfo           ,
#endif
    noSelectionGetModel                     ,


-- ** new #method:new#

    noSelectionNew                          ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    NoSelectionSetModelMethodInfo           ,
#endif
    noSelectionSetModel                     ,




 -- * Properties


-- ** itemType #attr:itemType#
-- | The type of items. See 'GI.Gio.Interfaces.ListModel.listModelGetItemType'.
-- 
-- /Since: 4.8/

#if defined(ENABLE_OVERLOADING)
    NoSelectionItemTypePropertyInfo         ,
#endif
    getNoSelectionItemType                  ,
#if defined(ENABLE_OVERLOADING)
    noSelectionItemType                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    NoSelectionModelPropertyInfo            ,
#endif
    clearNoSelectionModel                   ,
    constructNoSelectionModel               ,
    getNoSelectionModel                     ,
#if defined(ENABLE_OVERLOADING)
    noSelectionModel                        ,
#endif
    setNoSelectionModel                     ,


-- ** nItems #attr:nItems#
-- | The number of items. See 'GI.Gio.Interfaces.ListModel.listModelGetNItems'.
-- 
-- /Since: 4.8/

#if defined(ENABLE_OVERLOADING)
    NoSelectionNItemsPropertyInfo           ,
#endif
    getNoSelectionNItems                    ,
#if defined(ENABLE_OVERLOADING)
    noSelectionNItems                       ,
#endif




    ) where

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

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

import qualified 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 NoSelection = NoSelection (SP.ManagedPtr NoSelection)
    deriving (NoSelection -> NoSelection -> Bool
(NoSelection -> NoSelection -> Bool)
-> (NoSelection -> NoSelection -> Bool) -> Eq NoSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoSelection -> NoSelection -> Bool
== :: NoSelection -> NoSelection -> Bool
$c/= :: NoSelection -> NoSelection -> Bool
/= :: NoSelection -> NoSelection -> Bool
Eq)

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

foreign import ccall "gtk_no_selection_get_type"
    c_gtk_no_selection_get_type :: IO B.Types.GType

instance B.Types.TypedObject NoSelection where
    glibType :: IO GType
glibType = IO GType
c_gtk_no_selection_get_type

instance B.Types.GObject NoSelection

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "item-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

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

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Gio", name = "ListModel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,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' noSelection #model
-- @
getNoSelectionModel :: (MonadIO m, IsNoSelection o) => o -> m (Maybe Gio.ListModel.ListModel)
getNoSelectionModel :: forall (m :: * -> *) o.
(MonadIO m, IsNoSelection o) =>
o -> m (Maybe ListModel)
getNoSelectionModel o
obj = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe 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' noSelection [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setNoSelectionModel :: (MonadIO m, IsNoSelection o, Gio.ListModel.IsListModel a) => o -> a -> m ()
setNoSelectionModel :: forall (m :: * -> *) o a.
(MonadIO m, IsNoSelection o, IsListModel a) =>
o -> a -> m ()
setNoSelectionModel o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"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`.
constructNoSelectionModel :: (IsNoSelection o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructNoSelectionModel :: forall o (m :: * -> *) a.
(IsNoSelection o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructNoSelectionModel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"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
-- @
clearNoSelectionModel :: (MonadIO m, IsNoSelection o) => o -> m ()
clearNoSelectionModel :: forall (m :: * -> *) o. (MonadIO m, IsNoSelection o) => o -> m ()
clearNoSelectionModel o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe 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 NoSelectionModelPropertyInfo
instance AttrInfo NoSelectionModelPropertyInfo where
    type AttrAllowedOps NoSelectionModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NoSelectionModelPropertyInfo = IsNoSelection
    type AttrSetTypeConstraint NoSelectionModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint NoSelectionModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType NoSelectionModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType NoSelectionModelPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel NoSelectionModelPropertyInfo = "model"
    type AttrOrigin NoSelectionModelPropertyInfo = NoSelection
    attrGet = getNoSelectionModel
    attrSet = setNoSelectionModel
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructNoSelectionModel
    attrClear = clearNoSelectionModel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.NoSelection.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-NoSelection.html#g:attr:model"
        })
#endif

-- VVV Prop "n-items"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList NoSelection
type instance O.AttributeList NoSelection = NoSelectionAttributeList
type NoSelectionAttributeList = ('[ '("itemType", NoSelectionItemTypePropertyInfo), '("model", NoSelectionModelPropertyInfo), '("nItems", NoSelectionNItemsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
noSelectionItemType :: AttrLabelProxy "itemType"
noSelectionItemType = AttrLabelProxy

noSelectionModel :: AttrLabelProxy "model"
noSelectionModel = AttrLabelProxy

noSelectionNItems :: AttrLabelProxy "nItems"
noSelectionNItems = AttrLabelProxy

#endif

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

#endif

-- method NoSelection::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"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "NoSelection" })
-- throws : False
-- Skip return : False

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

-- | Creates a new selection to handle /@model@/.
noSelectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    Maybe (a)
    -- ^ /@model@/: the @GListModel@ to manage
    -> m NoSelection
    -- ^ __Returns:__ a new @GtkNoSelection@
noSelectionNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
Maybe a -> m NoSelection
noSelectionNew Maybe a
model = IO NoSelection -> m NoSelection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NoSelection -> m NoSelection)
-> IO NoSelection -> m NoSelection
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr NoSelection
result <- Ptr ListModel -> IO (Ptr NoSelection)
gtk_no_selection_new Ptr ListModel
maybeModel
    Text -> Ptr NoSelection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"noSelectionNew" Ptr NoSelection
result
    NoSelection
result' <- ((ManagedPtr NoSelection -> NoSelection)
-> Ptr NoSelection -> IO NoSelection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr NoSelection -> NoSelection
NoSelection) Ptr NoSelection
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
    NoSelection -> IO NoSelection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NoSelection
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method NoSelection::get_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NoSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkNoSelection`" , 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_no_selection_get_model" gtk_no_selection_get_model :: 
    Ptr NoSelection ->                      -- self : TInterface (Name {namespace = "Gtk", name = "NoSelection"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the model that /@self@/ is wrapping.
noSelectionGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsNoSelection a) =>
    a
    -- ^ /@self@/: a @GtkNoSelection@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model being wrapped
noSelectionGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNoSelection a) =>
a -> m (Maybe ListModel)
noSelectionGetModel a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr NoSelection
self' <- a -> IO (Ptr NoSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr NoSelection -> IO (Ptr ListModel)
gtk_no_selection_get_model Ptr NoSelection
self'
    Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
        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'
        ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data NoSelectionGetModelMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsNoSelection a) => O.OverloadedMethod NoSelectionGetModelMethodInfo a signature where
    overloadedMethod = noSelectionGetModel

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


#endif

-- method NoSelection::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NoSelection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkNoSelection`" , 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_no_selection_set_model" gtk_no_selection_set_model :: 
    Ptr NoSelection ->                      -- self : TInterface (Name {namespace = "Gtk", name = "NoSelection"})
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | Sets the model that /@self@/ should wrap.
-- 
-- If /@model@/ is 'P.Nothing', this model will be empty.
noSelectionSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsNoSelection a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a @GtkNoSelection@
    -> Maybe (b)
    -- ^ /@model@/: A @GListModel@ to wrap
    -> m ()
noSelectionSetModel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNoSelection a, IsListModel b) =>
a -> Maybe b -> m ()
noSelectionSetModel a
self Maybe b
model = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr NoSelection
self' <- a -> IO (Ptr NoSelection)
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr NoSelection -> Ptr ListModel -> IO ()
gtk_no_selection_set_model Ptr NoSelection
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif