{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkSelectionFilterModel@ is a list model that presents the selection from
-- a @GtkSelectionModel@.

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

module GI.Gtk.Objects.SelectionFilterModel
    ( 

-- * Exported types
    SelectionFilterModel(..)                ,
    IsSelectionFilterModel                  ,
    toSelectionFilterModel                  ,


 -- * 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"), [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"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [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.SelectionFilterModel#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").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setModel]("GI.Gtk.Objects.SelectionFilterModel#g:method:setModel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSelectionFilterModelMethod       ,
#endif

-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    SelectionFilterModelGetModelMethodInfo  ,
#endif
    selectionFilterModelGetModel            ,


-- ** new #method:new#

    selectionFilterModelNew                 ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    SelectionFilterModelSetModelMethodInfo  ,
#endif
    selectionFilterModelSetModel            ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    SelectionFilterModelItemTypePropertyInfo,
#endif
    getSelectionFilterModelItemType         ,
#if defined(ENABLE_OVERLOADING)
    selectionFilterModelItemType            ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SelectionFilterModelModelPropertyInfo   ,
#endif
    clearSelectionFilterModelModel          ,
    constructSelectionFilterModelModel      ,
    getSelectionFilterModelModel            ,
#if defined(ENABLE_OVERLOADING)
    selectionFilterModelModel               ,
#endif
    setSelectionFilterModelModel            ,


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

#if defined(ENABLE_OVERLOADING)
    SelectionFilterModelNItemsPropertyInfo  ,
#endif
    getSelectionFilterModelNItems           ,
#if defined(ENABLE_OVERLOADING)
    selectionFilterModelNItems              ,
#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 SelectionFilterModel = SelectionFilterModel (SP.ManagedPtr SelectionFilterModel)
    deriving (SelectionFilterModel -> SelectionFilterModel -> Bool
(SelectionFilterModel -> SelectionFilterModel -> Bool)
-> (SelectionFilterModel -> SelectionFilterModel -> Bool)
-> Eq SelectionFilterModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectionFilterModel -> SelectionFilterModel -> Bool
== :: SelectionFilterModel -> SelectionFilterModel -> Bool
$c/= :: SelectionFilterModel -> SelectionFilterModel -> Bool
/= :: SelectionFilterModel -> SelectionFilterModel -> Bool
Eq)

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

foreign import ccall "gtk_selection_filter_model_get_type"
    c_gtk_selection_filter_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject SelectionFilterModel where
    glibType :: IO GType
glibType = IO GType
c_gtk_selection_filter_model_get_type

instance B.Types.GObject SelectionFilterModel

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSelectionFilterModelMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSelectionFilterModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSelectionFilterModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSelectionFilterModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSelectionFilterModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSelectionFilterModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSelectionFilterModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSelectionFilterModelMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveSelectionFilterModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSelectionFilterModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSelectionFilterModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSelectionFilterModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSelectionFilterModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSelectionFilterModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSelectionFilterModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSelectionFilterModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSelectionFilterModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSelectionFilterModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSelectionFilterModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSelectionFilterModelMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveSelectionFilterModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveSelectionFilterModelMethod "getModel" o = SelectionFilterModelGetModelMethodInfo
    ResolveSelectionFilterModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveSelectionFilterModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSelectionFilterModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSelectionFilterModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSelectionFilterModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSelectionFilterModelMethod "setModel" o = SelectionFilterModelSetModelMethodInfo
    ResolveSelectionFilterModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSelectionFilterModelMethod l o = O.MethodResolutionFailed l o

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

#endif

instance (info ~ ResolveSelectionFilterModelMethod t SelectionFilterModel, O.OverloadedMethodInfo info SelectionFilterModel) => OL.IsLabel t (O.MethodProxy info SelectionFilterModel) 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' selectionFilterModel #itemType
-- @
getSelectionFilterModelItemType :: (MonadIO m, IsSelectionFilterModel o) => o -> m GType
getSelectionFilterModelItemType :: forall (m :: * -> *) o.
(MonadIO m, IsSelectionFilterModel o) =>
o -> m GType
getSelectionFilterModelItemType 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 SelectionFilterModelItemTypePropertyInfo
instance AttrInfo SelectionFilterModelItemTypePropertyInfo where
    type AttrAllowedOps SelectionFilterModelItemTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SelectionFilterModelItemTypePropertyInfo = IsSelectionFilterModel
    type AttrSetTypeConstraint SelectionFilterModelItemTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint SelectionFilterModelItemTypePropertyInfo = (~) ()
    type AttrTransferType SelectionFilterModelItemTypePropertyInfo = ()
    type AttrGetType SelectionFilterModelItemTypePropertyInfo = GType
    type AttrLabel SelectionFilterModelItemTypePropertyInfo = "item-type"
    type AttrOrigin SelectionFilterModelItemTypePropertyInfo = SelectionFilterModel
    attrGet = getSelectionFilterModelItemType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.SelectionFilterModel.itemType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-SelectionFilterModel.html#g:attr:itemType"
        })
#endif

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Gtk", name = "SelectionModel"})
   -- 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' selectionFilterModel #model
-- @
getSelectionFilterModelModel :: (MonadIO m, IsSelectionFilterModel o) => o -> m (Maybe Gtk.SelectionModel.SelectionModel)
getSelectionFilterModelModel :: forall (m :: * -> *) o.
(MonadIO m, IsSelectionFilterModel o) =>
o -> m (Maybe SelectionModel)
getSelectionFilterModelModel o
obj = IO (Maybe SelectionModel) -> m (Maybe SelectionModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe SelectionModel) -> m (Maybe SelectionModel))
-> IO (Maybe SelectionModel) -> m (Maybe SelectionModel)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr SelectionModel -> SelectionModel)
-> IO (Maybe SelectionModel)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"model" ManagedPtr SelectionModel -> SelectionModel
Gtk.SelectionModel.SelectionModel

-- | 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' selectionFilterModel [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setSelectionFilterModelModel :: (MonadIO m, IsSelectionFilterModel o, Gtk.SelectionModel.IsSelectionModel a) => o -> a -> m ()
setSelectionFilterModelModel :: forall (m :: * -> *) o a.
(MonadIO m, IsSelectionFilterModel o, IsSelectionModel a) =>
o -> a -> m ()
setSelectionFilterModelModel 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`.
constructSelectionFilterModelModel :: (IsSelectionFilterModel o, MIO.MonadIO m, Gtk.SelectionModel.IsSelectionModel a) => a -> m (GValueConstruct o)
constructSelectionFilterModelModel :: forall o (m :: * -> *) a.
(IsSelectionFilterModel o, MonadIO m, IsSelectionModel a) =>
a -> m (GValueConstruct o)
constructSelectionFilterModelModel 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
-- @
clearSelectionFilterModelModel :: (MonadIO m, IsSelectionFilterModel o) => o -> m ()
clearSelectionFilterModelModel :: forall (m :: * -> *) o.
(MonadIO m, IsSelectionFilterModel o) =>
o -> m ()
clearSelectionFilterModelModel 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 SelectionModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (Maybe SelectionModel
forall a. Maybe a
Nothing :: Maybe Gtk.SelectionModel.SelectionModel)

#if defined(ENABLE_OVERLOADING)
data SelectionFilterModelModelPropertyInfo
instance AttrInfo SelectionFilterModelModelPropertyInfo where
    type AttrAllowedOps SelectionFilterModelModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SelectionFilterModelModelPropertyInfo = IsSelectionFilterModel
    type AttrSetTypeConstraint SelectionFilterModelModelPropertyInfo = Gtk.SelectionModel.IsSelectionModel
    type AttrTransferTypeConstraint SelectionFilterModelModelPropertyInfo = Gtk.SelectionModel.IsSelectionModel
    type AttrTransferType SelectionFilterModelModelPropertyInfo = Gtk.SelectionModel.SelectionModel
    type AttrGetType SelectionFilterModelModelPropertyInfo = (Maybe Gtk.SelectionModel.SelectionModel)
    type AttrLabel SelectionFilterModelModelPropertyInfo = "model"
    type AttrOrigin SelectionFilterModelModelPropertyInfo = SelectionFilterModel
    attrGet = getSelectionFilterModelModel
    attrSet = setSelectionFilterModelModel
    attrTransfer _ v = do
        unsafeCastTo Gtk.SelectionModel.SelectionModel v
    attrConstruct = constructSelectionFilterModelModel
    attrClear = clearSelectionFilterModelModel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.SelectionFilterModel.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-SelectionFilterModel.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' selectionFilterModel #nItems
-- @
getSelectionFilterModelNItems :: (MonadIO m, IsSelectionFilterModel o) => o -> m Word32
getSelectionFilterModelNItems :: forall (m :: * -> *) o.
(MonadIO m, IsSelectionFilterModel o) =>
o -> m Word32
getSelectionFilterModelNItems 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 SelectionFilterModelNItemsPropertyInfo
instance AttrInfo SelectionFilterModelNItemsPropertyInfo where
    type AttrAllowedOps SelectionFilterModelNItemsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SelectionFilterModelNItemsPropertyInfo = IsSelectionFilterModel
    type AttrSetTypeConstraint SelectionFilterModelNItemsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SelectionFilterModelNItemsPropertyInfo = (~) ()
    type AttrTransferType SelectionFilterModelNItemsPropertyInfo = ()
    type AttrGetType SelectionFilterModelNItemsPropertyInfo = Word32
    type AttrLabel SelectionFilterModelNItemsPropertyInfo = "n-items"
    type AttrOrigin SelectionFilterModelNItemsPropertyInfo = SelectionFilterModel
    attrGet = getSelectionFilterModelNItems
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.SelectionFilterModel.nItems"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-SelectionFilterModel.html#g:attr:nItems"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SelectionFilterModel
type instance O.AttributeList SelectionFilterModel = SelectionFilterModelAttributeList
type SelectionFilterModelAttributeList = ('[ '("itemType", SelectionFilterModelItemTypePropertyInfo), '("model", SelectionFilterModelModelPropertyInfo), '("nItems", SelectionFilterModelNItemsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

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

selectionFilterModelModel :: AttrLabelProxy "model"
selectionFilterModelModel = AttrLabelProxy

selectionFilterModelNItems :: AttrLabelProxy "nItems"
selectionFilterModelNItems = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SelectionFilterModel = SelectionFilterModelSignalList
type SelectionFilterModelSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method SelectionFilterModel::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the selection model to filter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gtk" , name = "SelectionFilterModel" })
-- throws : False
-- Skip return : False

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

-- | Creates a new @GtkSelectionFilterModel@ that will include the
-- selected items from the underlying selection model.
selectionFilterModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.SelectionModel.IsSelectionModel a) =>
    Maybe (a)
    -- ^ /@model@/: the selection model to filter
    -> m SelectionFilterModel
    -- ^ __Returns:__ a new @GtkSelectionFilterModel@
selectionFilterModelNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionModel a) =>
Maybe a -> m SelectionFilterModel
selectionFilterModelNew Maybe a
model = IO SelectionFilterModel -> m SelectionFilterModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SelectionFilterModel -> m SelectionFilterModel)
-> IO SelectionFilterModel -> m SelectionFilterModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr SelectionModel
maybeModel <- case Maybe a
model of
        Maybe a
Nothing -> Ptr SelectionModel -> IO (Ptr SelectionModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SelectionModel
forall a. Ptr a
nullPtr
        Just a
jModel -> do
            Ptr SelectionModel
jModel' <- a -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jModel
            Ptr SelectionModel -> IO (Ptr SelectionModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SelectionModel
jModel'
    Ptr SelectionFilterModel
result <- Ptr SelectionModel -> IO (Ptr SelectionFilterModel)
gtk_selection_filter_model_new Ptr SelectionModel
maybeModel
    Text -> Ptr SelectionFilterModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"selectionFilterModelNew" Ptr SelectionFilterModel
result
    SelectionFilterModel
result' <- ((ManagedPtr SelectionFilterModel -> SelectionFilterModel)
-> Ptr SelectionFilterModel -> IO SelectionFilterModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SelectionFilterModel -> SelectionFilterModel
SelectionFilterModel) Ptr SelectionFilterModel
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
    SelectionFilterModel -> IO SelectionFilterModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SelectionFilterModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_selection_filter_model_get_model" gtk_selection_filter_model_get_model :: 
    Ptr SelectionFilterModel ->             -- self : TInterface (Name {namespace = "Gtk", name = "SelectionFilterModel"})
    IO (Ptr Gtk.SelectionModel.SelectionModel)

-- | Gets the model currently filtered or 'P.Nothing' if none.
selectionFilterModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionFilterModel a) =>
    a
    -- ^ /@self@/: a @GtkSelectionFilterModel@
    -> m (Maybe Gtk.SelectionModel.SelectionModel)
    -- ^ __Returns:__ The model that gets filtered
selectionFilterModelGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelectionFilterModel a) =>
a -> m (Maybe SelectionModel)
selectionFilterModelGetModel a
self = IO (Maybe SelectionModel) -> m (Maybe SelectionModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SelectionModel) -> m (Maybe SelectionModel))
-> IO (Maybe SelectionModel) -> m (Maybe SelectionModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SelectionFilterModel
self' <- a -> IO (Ptr SelectionFilterModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SelectionModel
result <- Ptr SelectionFilterModel -> IO (Ptr SelectionModel)
gtk_selection_filter_model_get_model Ptr SelectionFilterModel
self'
    Maybe SelectionModel
maybeResult <- Ptr SelectionModel
-> (Ptr SelectionModel -> IO SelectionModel)
-> IO (Maybe SelectionModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SelectionModel
result ((Ptr SelectionModel -> IO SelectionModel)
 -> IO (Maybe SelectionModel))
-> (Ptr SelectionModel -> IO SelectionModel)
-> IO (Maybe SelectionModel)
forall a b. (a -> b) -> a -> b
$ \Ptr SelectionModel
result' -> do
        SelectionModel
result'' <- ((ManagedPtr SelectionModel -> SelectionModel)
-> Ptr SelectionModel -> IO SelectionModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SelectionModel -> SelectionModel
Gtk.SelectionModel.SelectionModel) Ptr SelectionModel
result'
        SelectionModel -> IO SelectionModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SelectionModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe SelectionModel -> IO (Maybe SelectionModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SelectionModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data SelectionFilterModelGetModelMethodInfo
instance (signature ~ (m (Maybe Gtk.SelectionModel.SelectionModel)), MonadIO m, IsSelectionFilterModel a) => O.OverloadedMethod SelectionFilterModelGetModelMethodInfo a signature where
    overloadedMethod = selectionFilterModelGetModel

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


#endif

-- method SelectionFilterModel::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "SelectionFilterModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSelectionFilterModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The model to be filtered"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the model to be filtered.
-- 
-- Note that GTK makes no effort to ensure that /@model@/ conforms to
-- the item type of /@self@/. It assumes that the caller knows what they
-- are doing and have set up an appropriate filter to ensure that item
-- types match.
selectionFilterModelSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelectionFilterModel a, Gtk.SelectionModel.IsSelectionModel b) =>
    a
    -- ^ /@self@/: a @GtkSelectionFilterModel@
    -> Maybe (b)
    -- ^ /@model@/: The model to be filtered
    -> m ()
selectionFilterModelSetModel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSelectionFilterModel a,
 IsSelectionModel b) =>
a -> Maybe b -> m ()
selectionFilterModelSetModel 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 SelectionFilterModel
self' <- a -> IO (Ptr SelectionFilterModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SelectionModel
maybeModel <- case Maybe b
model of
        Maybe b
Nothing -> Ptr SelectionModel -> IO (Ptr SelectionModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SelectionModel
forall a. Ptr a
nullPtr
        Just b
jModel -> do
            Ptr SelectionModel
jModel' <- b -> IO (Ptr SelectionModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            Ptr SelectionModel -> IO (Ptr SelectionModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SelectionModel
jModel'
    Ptr SelectionFilterModel -> Ptr SelectionModel -> IO ()
gtk_selection_filter_model_set_model Ptr SelectionFilterModel
self' Ptr SelectionModel
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 SelectionFilterModelSetModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSelectionFilterModel a, Gtk.SelectionModel.IsSelectionModel b) => O.OverloadedMethod SelectionFilterModelSetModelMethodInfo a signature where
    overloadedMethod = selectionFilterModelSetModel

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


#endif