{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkFilterListModel@ is a list model that filters the elements of
-- the underlying model according to a @GtkFilter@.
-- 
-- It hides some elements from the other model according to
-- criteria given by a @GtkFilter@.
-- 
-- The model can be set up to do incremental searching, so that
-- filtering long lists doesn\'t block the UI. See
-- 'GI.Gtk.Objects.FilterListModel.filterListModelSetIncremental' for details.

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

module GI.Gtk.Objects.FilterListModel
    ( 

-- * Exported types
    FilterListModel(..)                     ,
    IsFilterListModel                       ,
    toFilterListModel                       ,


 -- * 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"), [getFilter]("GI.Gtk.Objects.FilterListModel#g:method:getFilter"), [getIncremental]("GI.Gtk.Objects.FilterListModel#g:method:getIncremental"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getModel]("GI.Gtk.Objects.FilterListModel#g:method:getModel"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getPending]("GI.Gtk.Objects.FilterListModel#g:method:getPending"), [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"), [setFilter]("GI.Gtk.Objects.FilterListModel#g:method:setFilter"), [setIncremental]("GI.Gtk.Objects.FilterListModel#g:method:setIncremental"), [setModel]("GI.Gtk.Objects.FilterListModel#g:method:setModel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFilterListModelMethod            ,
#endif

-- ** getFilter #method:getFilter#

#if defined(ENABLE_OVERLOADING)
    FilterListModelGetFilterMethodInfo      ,
#endif
    filterListModelGetFilter                ,


-- ** getIncremental #method:getIncremental#

#if defined(ENABLE_OVERLOADING)
    FilterListModelGetIncrementalMethodInfo ,
#endif
    filterListModelGetIncremental           ,


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    FilterListModelGetModelMethodInfo       ,
#endif
    filterListModelGetModel                 ,


-- ** getPending #method:getPending#

#if defined(ENABLE_OVERLOADING)
    FilterListModelGetPendingMethodInfo     ,
#endif
    filterListModelGetPending               ,


-- ** new #method:new#

    filterListModelNew                      ,


-- ** setFilter #method:setFilter#

#if defined(ENABLE_OVERLOADING)
    FilterListModelSetFilterMethodInfo      ,
#endif
    filterListModelSetFilter                ,


-- ** setIncremental #method:setIncremental#

#if defined(ENABLE_OVERLOADING)
    FilterListModelSetIncrementalMethodInfo ,
#endif
    filterListModelSetIncremental           ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    FilterListModelSetModelMethodInfo       ,
#endif
    filterListModelSetModel                 ,




 -- * Properties


-- ** filter #attr:filter#
-- | The filter for this model.

#if defined(ENABLE_OVERLOADING)
    FilterListModelFilterPropertyInfo       ,
#endif
    clearFilterListModelFilter              ,
    constructFilterListModelFilter          ,
#if defined(ENABLE_OVERLOADING)
    filterListModelFilter                   ,
#endif
    getFilterListModelFilter                ,
    setFilterListModelFilter                ,


-- ** incremental #attr:incremental#
-- | If the model should filter items incrementally.

#if defined(ENABLE_OVERLOADING)
    FilterListModelIncrementalPropertyInfo  ,
#endif
    constructFilterListModelIncremental     ,
#if defined(ENABLE_OVERLOADING)
    filterListModelIncremental              ,
#endif
    getFilterListModelIncremental           ,
    setFilterListModelIncremental           ,


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

#if defined(ENABLE_OVERLOADING)
    FilterListModelItemTypePropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    filterListModelItemType                 ,
#endif
    getFilterListModelItemType              ,


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

#if defined(ENABLE_OVERLOADING)
    FilterListModelModelPropertyInfo        ,
#endif
    clearFilterListModelModel               ,
    constructFilterListModelModel           ,
#if defined(ENABLE_OVERLOADING)
    filterListModelModel                    ,
#endif
    getFilterListModelModel                 ,
    setFilterListModelModel                 ,


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

#if defined(ENABLE_OVERLOADING)
    FilterListModelNItemsPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    filterListModelNItems                   ,
#endif
    getFilterListModelNItems                ,


-- ** pending #attr:pending#
-- | Number of items not yet filtered.

#if defined(ENABLE_OVERLOADING)
    FilterListModelPendingPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    filterListModelPending                  ,
#endif
    getFilterListModelPending               ,




    ) 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.Objects.Filter as Gtk.Filter

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

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

foreign import ccall "gtk_filter_list_model_get_type"
    c_gtk_filter_list_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject FilterListModel where
    glibType :: IO GType
glibType = IO GType
c_gtk_filter_list_model_get_type

instance B.Types.GObject FilterListModel

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "filter"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Filter"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@filter@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' filterListModel [ #filter 'Data.GI.Base.Attributes.:=' value ]
-- @
setFilterListModelFilter :: (MonadIO m, IsFilterListModel o, Gtk.Filter.IsFilter a) => o -> a -> m ()
setFilterListModelFilter :: forall (m :: * -> *) o a.
(MonadIO m, IsFilterListModel o, IsFilter a) =>
o -> a -> m ()
setFilterListModelFilter 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
"filter" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@filter@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFilterListModelFilter :: (IsFilterListModel o, MIO.MonadIO m, Gtk.Filter.IsFilter a) => a -> m (GValueConstruct o)
constructFilterListModelFilter :: forall o (m :: * -> *) a.
(IsFilterListModel o, MonadIO m, IsFilter a) =>
a -> m (GValueConstruct o)
constructFilterListModelFilter 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
"filter" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@filter@” 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' #filter
-- @
clearFilterListModelFilter :: (MonadIO m, IsFilterListModel o) => o -> m ()
clearFilterListModelFilter :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m ()
clearFilterListModelFilter 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 Filter -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"filter" (Maybe Filter
forall a. Maybe a
Nothing :: Maybe Gtk.Filter.Filter)

#if defined(ENABLE_OVERLOADING)
data FilterListModelFilterPropertyInfo
instance AttrInfo FilterListModelFilterPropertyInfo where
    type AttrAllowedOps FilterListModelFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FilterListModelFilterPropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelFilterPropertyInfo = Gtk.Filter.IsFilter
    type AttrTransferTypeConstraint FilterListModelFilterPropertyInfo = Gtk.Filter.IsFilter
    type AttrTransferType FilterListModelFilterPropertyInfo = Gtk.Filter.Filter
    type AttrGetType FilterListModelFilterPropertyInfo = (Maybe Gtk.Filter.Filter)
    type AttrLabel FilterListModelFilterPropertyInfo = "filter"
    type AttrOrigin FilterListModelFilterPropertyInfo = FilterListModel
    attrGet = getFilterListModelFilter
    attrSet = setFilterListModelFilter
    attrTransfer _ v = do
        unsafeCastTo Gtk.Filter.Filter v
    attrConstruct = constructFilterListModelFilter
    attrClear = clearFilterListModelFilter
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FilterListModel.filter"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FilterListModel.html#g:attr:filter"
        })
#endif

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

-- | Get the value of the “@incremental@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' filterListModel #incremental
-- @
getFilterListModelIncremental :: (MonadIO m, IsFilterListModel o) => o -> m Bool
getFilterListModelIncremental :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m Bool
getFilterListModelIncremental o
obj = IO Bool -> m Bool
forall a. IO a -> m a
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
"incremental"

-- | Set the value of the “@incremental@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' filterListModel [ #incremental 'Data.GI.Base.Attributes.:=' value ]
-- @
setFilterListModelIncremental :: (MonadIO m, IsFilterListModel o) => o -> Bool -> m ()
setFilterListModelIncremental :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> Bool -> m ()
setFilterListModelIncremental o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"incremental" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@incremental@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFilterListModelIncremental :: (IsFilterListModel o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructFilterListModelIncremental :: forall o (m :: * -> *).
(IsFilterListModel o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructFilterListModelIncremental Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"incremental" Bool
val

#if defined(ENABLE_OVERLOADING)
data FilterListModelIncrementalPropertyInfo
instance AttrInfo FilterListModelIncrementalPropertyInfo where
    type AttrAllowedOps FilterListModelIncrementalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FilterListModelIncrementalPropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelIncrementalPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FilterListModelIncrementalPropertyInfo = (~) Bool
    type AttrTransferType FilterListModelIncrementalPropertyInfo = Bool
    type AttrGetType FilterListModelIncrementalPropertyInfo = Bool
    type AttrLabel FilterListModelIncrementalPropertyInfo = "incremental"
    type AttrOrigin FilterListModelIncrementalPropertyInfo = FilterListModel
    attrGet = getFilterListModelIncremental
    attrSet = setFilterListModelIncremental
    attrTransfer _ v = do
        return v
    attrConstruct = constructFilterListModelIncremental
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FilterListModel.incremental"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FilterListModel.html#g:attr:incremental"
        })
#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' filterListModel #itemType
-- @
getFilterListModelItemType :: (MonadIO m, IsFilterListModel o) => o -> m GType
getFilterListModelItemType :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m GType
getFilterListModelItemType 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 FilterListModelItemTypePropertyInfo
instance AttrInfo FilterListModelItemTypePropertyInfo where
    type AttrAllowedOps FilterListModelItemTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint FilterListModelItemTypePropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelItemTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint FilterListModelItemTypePropertyInfo = (~) ()
    type AttrTransferType FilterListModelItemTypePropertyInfo = ()
    type AttrGetType FilterListModelItemTypePropertyInfo = GType
    type AttrLabel FilterListModelItemTypePropertyInfo = "item-type"
    type AttrOrigin FilterListModelItemTypePropertyInfo = FilterListModel
    attrGet = getFilterListModelItemType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FilterListModel.itemType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FilterListModel.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' filterListModel #model
-- @
getFilterListModelModel :: (MonadIO m, IsFilterListModel o) => o -> m (Maybe Gio.ListModel.ListModel)
getFilterListModelModel :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m (Maybe ListModel)
getFilterListModelModel 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' filterListModel [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setFilterListModelModel :: (MonadIO m, IsFilterListModel o, Gio.ListModel.IsListModel a) => o -> a -> m ()
setFilterListModelModel :: forall (m :: * -> *) o a.
(MonadIO m, IsFilterListModel o, IsListModel a) =>
o -> a -> m ()
setFilterListModelModel 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`.
constructFilterListModelModel :: (IsFilterListModel o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructFilterListModelModel :: forall o (m :: * -> *) a.
(IsFilterListModel o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructFilterListModelModel 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
-- @
clearFilterListModelModel :: (MonadIO m, IsFilterListModel o) => o -> m ()
clearFilterListModelModel :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m ()
clearFilterListModelModel 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 FilterListModelModelPropertyInfo
instance AttrInfo FilterListModelModelPropertyInfo where
    type AttrAllowedOps FilterListModelModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FilterListModelModelPropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint FilterListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType FilterListModelModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType FilterListModelModelPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel FilterListModelModelPropertyInfo = "model"
    type AttrOrigin FilterListModelModelPropertyInfo = FilterListModel
    attrGet = getFilterListModelModel
    attrSet = setFilterListModelModel
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructFilterListModelModel
    attrClear = clearFilterListModelModel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FilterListModel.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FilterListModel.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' filterListModel #nItems
-- @
getFilterListModelNItems :: (MonadIO m, IsFilterListModel o) => o -> m Word32
getFilterListModelNItems :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m Word32
getFilterListModelNItems 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 FilterListModelNItemsPropertyInfo
instance AttrInfo FilterListModelNItemsPropertyInfo where
    type AttrAllowedOps FilterListModelNItemsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint FilterListModelNItemsPropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelNItemsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint FilterListModelNItemsPropertyInfo = (~) ()
    type AttrTransferType FilterListModelNItemsPropertyInfo = ()
    type AttrGetType FilterListModelNItemsPropertyInfo = Word32
    type AttrLabel FilterListModelNItemsPropertyInfo = "n-items"
    type AttrOrigin FilterListModelNItemsPropertyInfo = FilterListModel
    attrGet = getFilterListModelNItems
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FilterListModel.nItems"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-FilterListModel.html#g:attr:nItems"
        })
#endif

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

-- | Get the value of the “@pending@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' filterListModel #pending
-- @
getFilterListModelPending :: (MonadIO m, IsFilterListModel o) => o -> m Word32
getFilterListModelPending :: forall (m :: * -> *) o.
(MonadIO m, IsFilterListModel o) =>
o -> m Word32
getFilterListModelPending 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
"pending"

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FilterListModel
type instance O.AttributeList FilterListModel = FilterListModelAttributeList
type FilterListModelAttributeList = ('[ '("filter", FilterListModelFilterPropertyInfo), '("incremental", FilterListModelIncrementalPropertyInfo), '("itemType", FilterListModelItemTypePropertyInfo), '("model", FilterListModelModelPropertyInfo), '("nItems", FilterListModelNItemsPropertyInfo), '("pending", FilterListModelPendingPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
filterListModelFilter :: AttrLabelProxy "filter"
filterListModelFilter = AttrLabelProxy

filterListModelIncremental :: AttrLabelProxy "incremental"
filterListModelIncremental = AttrLabelProxy

filterListModelItemType :: AttrLabelProxy "itemType"
filterListModelItemType = AttrLabelProxy

filterListModelModel :: AttrLabelProxy "model"
filterListModelModel = AttrLabelProxy

filterListModelNItems :: AttrLabelProxy "nItems"
filterListModelNItems = AttrLabelProxy

filterListModelPending :: AttrLabelProxy "pending"
filterListModelPending = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_filter_list_model_new" gtk_filter_list_model_new :: 
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    Ptr Gtk.Filter.Filter ->                -- filter : TInterface (Name {namespace = "Gtk", name = "Filter"})
    IO (Ptr FilterListModel)

-- | Creates a new @GtkFilterListModel@ that will filter /@model@/ using the given
-- /@filter@/.
filterListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a, Gtk.Filter.IsFilter b) =>
    Maybe (a)
    -- ^ /@model@/: the model to sort
    -> Maybe (b)
    -- ^ /@filter@/: filter
    -> m FilterListModel
    -- ^ __Returns:__ a new @GtkFilterListModel@
filterListModelNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListModel a, IsFilter b) =>
Maybe a -> Maybe b -> m FilterListModel
filterListModelNew Maybe a
model Maybe b
filter = IO FilterListModel -> m FilterListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilterListModel -> m FilterListModel)
-> IO FilterListModel -> m FilterListModel
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 Filter
maybeFilter <- case Maybe b
filter of
        Maybe b
Nothing -> Ptr Filter -> IO (Ptr Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Filter
forall a. Ptr a
nullPtr
        Just b
jFilter -> do
            Ptr Filter
jFilter' <- b -> IO (Ptr Filter)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
jFilter
            Ptr Filter -> IO (Ptr Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Filter
jFilter'
    Ptr FilterListModel
result <- Ptr ListModel -> Ptr Filter -> IO (Ptr FilterListModel)
gtk_filter_list_model_new Ptr ListModel
maybeModel Ptr Filter
maybeFilter
    Text -> Ptr FilterListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"filterListModelNew" Ptr FilterListModel
result
    FilterListModel
result' <- ((ManagedPtr FilterListModel -> FilterListModel)
-> Ptr FilterListModel -> IO FilterListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FilterListModel -> FilterListModel
FilterListModel) Ptr FilterListModel
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
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
filter b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    FilterListModel -> IO FilterListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilterListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_filter_list_model_get_filter" gtk_filter_list_model_get_filter :: 
    Ptr FilterListModel ->                  -- self : TInterface (Name {namespace = "Gtk", name = "FilterListModel"})
    IO (Ptr Gtk.Filter.Filter)

-- | Gets the @GtkFilter@ currently set on /@self@/.
filterListModelGetFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> m (Maybe Gtk.Filter.Filter)
    -- ^ __Returns:__ The filter currently in use
filterListModelGetFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFilterListModel a) =>
a -> m (Maybe Filter)
filterListModelGetFilter a
self = IO (Maybe Filter) -> m (Maybe Filter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Filter) -> m (Maybe Filter))
-> IO (Maybe Filter) -> m (Maybe Filter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Filter
result <- Ptr FilterListModel -> IO (Ptr Filter)
gtk_filter_list_model_get_filter Ptr FilterListModel
self'
    Maybe Filter
maybeResult <- Ptr Filter -> (Ptr Filter -> IO Filter) -> IO (Maybe Filter)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Filter
result ((Ptr Filter -> IO Filter) -> IO (Maybe Filter))
-> (Ptr Filter -> IO Filter) -> IO (Maybe Filter)
forall a b. (a -> b) -> a -> b
$ \Ptr Filter
result' -> do
        Filter
result'' <- ((ManagedPtr Filter -> Filter) -> Ptr Filter -> IO Filter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Filter -> Filter
Gtk.Filter.Filter) Ptr Filter
result'
        Filter -> IO Filter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Filter -> IO (Maybe Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Filter
maybeResult

#if defined(ENABLE_OVERLOADING)
data FilterListModelGetFilterMethodInfo
instance (signature ~ (m (Maybe Gtk.Filter.Filter)), MonadIO m, IsFilterListModel a) => O.OverloadedMethod FilterListModelGetFilterMethodInfo a signature where
    overloadedMethod = filterListModelGetFilter

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


#endif

-- method FilterListModel::get_incremental
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FilterListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFilterListModel`"
--                 , 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_filter_list_model_get_incremental" gtk_filter_list_model_get_incremental :: 
    Ptr FilterListModel ->                  -- self : TInterface (Name {namespace = "Gtk", name = "FilterListModel"})
    IO CInt

-- | Returns whether incremental filtering is enabled.
-- 
-- See 'GI.Gtk.Objects.FilterListModel.filterListModelSetIncremental'.
filterListModelGetIncremental ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if incremental filtering is enabled
filterListModelGetIncremental :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFilterListModel a) =>
a -> m Bool
filterListModelGetIncremental a
self = IO Bool -> m Bool
forall a. IO a -> m a
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 FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr FilterListModel -> IO CInt
gtk_filter_list_model_get_incremental Ptr FilterListModel
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FilterListModelGetIncrementalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFilterListModel a) => O.OverloadedMethod FilterListModelGetIncrementalMethodInfo a signature where
    overloadedMethod = filterListModelGetIncremental

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


#endif

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

-- | Gets the model currently filtered or 'P.Nothing' if none.
filterListModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model that gets filtered
filterListModelGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFilterListModel a) =>
a -> m (Maybe ListModel)
filterListModelGetModel 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 FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr FilterListModel -> IO (Ptr ListModel)
gtk_filter_list_model_get_model Ptr FilterListModel
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 FilterListModelGetModelMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsFilterListModel a) => O.OverloadedMethod FilterListModelGetModelMethodInfo a signature where
    overloadedMethod = filterListModelGetModel

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


#endif

-- method FilterListModel::get_pending
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FilterListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFilterListModel`"
--                 , 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_filter_list_model_get_pending" gtk_filter_list_model_get_pending :: 
    Ptr FilterListModel ->                  -- self : TInterface (Name {namespace = "Gtk", name = "FilterListModel"})
    IO Word32

-- | Returns the number of items that have not been filtered yet.
-- 
-- You can use this value to check if /@self@/ is busy filtering by
-- comparing the return value to 0 or you can compute the percentage
-- of the filter remaining by dividing the return value by the total
-- number of items in the underlying model:
-- 
-- 
-- === /c code/
-- >pending = gtk_filter_list_model_get_pending (self);
-- >model = gtk_filter_list_model_get_model (self);
-- >percentage = pending / (double) g_list_model_get_n_items (model);
-- 
-- 
-- If no filter operation is ongoing - in particular when
-- [FilterListModel:incremental]("GI.Gtk.Objects.FilterListModel#g:attr:incremental") is 'P.False' - this
-- function returns 0.
filterListModelGetPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> m Word32
    -- ^ __Returns:__ The number of items not yet filtered
filterListModelGetPending :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFilterListModel a) =>
a -> m Word32
filterListModelGetPending a
self = IO Word32 -> m Word32
forall a. IO a -> m a
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 FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr FilterListModel -> IO Word32
gtk_filter_list_model_get_pending Ptr FilterListModel
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data FilterListModelGetPendingMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsFilterListModel a) => O.OverloadedMethod FilterListModelGetPendingMethodInfo a signature where
    overloadedMethod = filterListModelGetPending

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


#endif

-- method FilterListModel::set_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FilterListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFilterListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Filter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filter to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_filter_list_model_set_filter" gtk_filter_list_model_set_filter :: 
    Ptr FilterListModel ->                  -- self : TInterface (Name {namespace = "Gtk", name = "FilterListModel"})
    Ptr Gtk.Filter.Filter ->                -- filter : TInterface (Name {namespace = "Gtk", name = "Filter"})
    IO ()

-- | Sets the filter used to filter items.
filterListModelSetFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a, Gtk.Filter.IsFilter b) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> Maybe (b)
    -- ^ /@filter@/: filter to use
    -> m ()
filterListModelSetFilter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFilterListModel a, IsFilter b) =>
a -> Maybe b -> m ()
filterListModelSetFilter a
self Maybe b
filter = 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 FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Filter
maybeFilter <- case Maybe b
filter of
        Maybe b
Nothing -> Ptr Filter -> IO (Ptr Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Filter
forall a. Ptr a
nullPtr
        Just b
jFilter -> do
            Ptr Filter
jFilter' <- b -> IO (Ptr Filter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFilter
            Ptr Filter -> IO (Ptr Filter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Filter
jFilter'
    Ptr FilterListModel -> Ptr Filter -> IO ()
gtk_filter_list_model_set_filter Ptr FilterListModel
self' Ptr Filter
maybeFilter
    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
filter 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 FilterListModelSetFilterMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFilterListModel a, Gtk.Filter.IsFilter b) => O.OverloadedMethod FilterListModelSetFilterMethodInfo a signature where
    overloadedMethod = filterListModelSetFilter

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


#endif

-- method FilterListModel::set_incremental
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FilterListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFilterListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "incremental"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable incremental filtering"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the filter model to do an incremental sort.
-- 
-- When incremental filtering is enabled, the @GtkFilterListModel@ will not
-- run filters immediately, but will instead queue an idle handler that
-- incrementally filters the items and adds them to the list. This of course
-- means that items are not instantly added to the list, but only appear
-- incrementally.
-- 
-- When your filter blocks the UI while filtering, you might consider
-- turning this on. Depending on your model and filters, this may become
-- interesting around 10,000 to 100,000 items.
-- 
-- By default, incremental filtering is disabled.
-- 
-- See 'GI.Gtk.Objects.FilterListModel.filterListModelGetPending' for progress information
-- about an ongoing incremental filtering operation.
filterListModelSetIncremental ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> Bool
    -- ^ /@incremental@/: 'P.True' to enable incremental filtering
    -> m ()
filterListModelSetIncremental :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFilterListModel a) =>
a -> Bool -> m ()
filterListModelSetIncremental a
self Bool
incremental = 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 FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let incremental' :: CInt
incremental' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
incremental
    Ptr FilterListModel -> CInt -> IO ()
gtk_filter_list_model_set_incremental Ptr FilterListModel
self' CInt
incremental'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FilterListModelSetIncrementalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFilterListModel a) => O.OverloadedMethod FilterListModelSetIncrementalMethodInfo a signature where
    overloadedMethod = filterListModelSetIncremental

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


#endif

-- method FilterListModel::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FilterListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFilterListModel`"
--                 , 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 "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_filter_list_model_set_model" gtk_filter_list_model_set_model :: 
    Ptr FilterListModel ->                  -- self : TInterface (Name {namespace = "Gtk", name = "FilterListModel"})
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    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.
filterListModelSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a @GtkFilterListModel@
    -> Maybe (b)
    -- ^ /@model@/: The model to be filtered
    -> m ()
filterListModelSetModel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFilterListModel a, IsListModel b) =>
a -> Maybe b -> m ()
filterListModelSetModel 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 FilterListModel
self' <- a -> IO (Ptr FilterListModel)
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 FilterListModel -> Ptr ListModel -> IO ()
gtk_filter_list_model_set_model Ptr FilterListModel
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 FilterListModelSetModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFilterListModel a, Gio.ListModel.IsListModel b) => O.OverloadedMethod FilterListModelSetModelMethodInfo a signature where
    overloadedMethod = filterListModelSetModel

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


#endif