{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.FilterListModel.FilterListModel' is a list model that filters a given other
-- listmodel.
-- It hides some elements from the other model according to
-- criteria given by a t'GI.Gtk.Callbacks.FilterListModelFilterFunc'.

#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                       ,
    noFilterListModel                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFilterListModelMethod            ,
#endif


-- ** getModel #method:getModel#

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


-- ** hasFilter #method:hasFilter#

#if defined(ENABLE_OVERLOADING)
    FilterListModelHasFilterMethodInfo      ,
#endif
    filterListModelHasFilter                ,


-- ** new #method:new#

    filterListModelNew                      ,


-- ** newForType #method:newForType#

    filterListModelNewForType               ,


-- ** refilter #method:refilter#

#if defined(ENABLE_OVERLOADING)
    FilterListModelRefilterMethodInfo       ,
#endif
    filterListModelRefilter                 ,


-- ** setFilterFunc #method:setFilterFunc#

#if defined(ENABLE_OVERLOADING)
    FilterListModelSetFilterFuncMethodInfo  ,
#endif
    filterListModelSetFilterFunc            ,


-- ** setModel #method:setModel#

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




 -- * Properties
-- ** hasFilter #attr:hasFilter#
-- | If a filter is set for this model

#if defined(ENABLE_OVERLOADING)
    FilterListModelHasFilterPropertyInfo    ,
#endif
    getFilterListModelHasFilter             ,


-- ** itemType #attr:itemType#
-- | The t'GType' for elements of this object

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


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

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




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gtk.Callbacks as Gtk.Callbacks

-- | Memory-managed wrapper type.
newtype FilterListModel = FilterListModel (ManagedPtr FilterListModel)
    deriving (FilterListModel -> FilterListModel -> Bool
(FilterListModel -> FilterListModel -> Bool)
-> (FilterListModel -> FilterListModel -> Bool)
-> Eq FilterListModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterListModel -> FilterListModel -> Bool
$c/= :: FilterListModel -> FilterListModel -> Bool
== :: FilterListModel -> FilterListModel -> Bool
$c== :: FilterListModel -> FilterListModel -> Bool
Eq)
foreign import ccall "gtk_filter_list_model_get_type"
    c_gtk_filter_list_model_get_type :: IO GType

instance GObject FilterListModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_filter_list_model_get_type
    

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `FilterListModel`.
noFilterListModel :: Maybe FilterListModel
noFilterListModel :: Maybe FilterListModel
noFilterListModel = Maybe FilterListModel
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveFilterListModelMethod (t :: Symbol) (o :: *) :: * 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 "hasFilter" o = FilterListModelHasFilterMethodInfo
    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 "refilter" o = FilterListModelRefilterMethodInfo
    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 "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveFilterListModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveFilterListModelMethod "getModel" o = FilterListModelGetModelMethodInfo
    ResolveFilterListModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    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 "setFilterFunc" o = FilterListModelSetFilterFuncMethodInfo
    ResolveFilterListModelMethod "setModel" o = FilterListModelSetModelMethodInfo
    ResolveFilterListModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFilterListModelMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "has-filter"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@has-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 #hasFilter
-- @
getFilterListModelHasFilter :: (MonadIO m, IsFilterListModel o) => o -> m Bool
getFilterListModelHasFilter :: o -> m Bool
getFilterListModelHasFilter obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "has-filter"

#if defined(ENABLE_OVERLOADING)
data FilterListModelHasFilterPropertyInfo
instance AttrInfo FilterListModelHasFilterPropertyInfo where
    type AttrAllowedOps FilterListModelHasFilterPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint FilterListModelHasFilterPropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelHasFilterPropertyInfo = (~) ()
    type AttrTransferTypeConstraint FilterListModelHasFilterPropertyInfo = (~) ()
    type AttrTransferType FilterListModelHasFilterPropertyInfo = ()
    type AttrGetType FilterListModelHasFilterPropertyInfo = Bool
    type AttrLabel FilterListModelHasFilterPropertyInfo = "has-filter"
    type AttrOrigin FilterListModelHasFilterPropertyInfo = FilterListModel
    attrGet = getFilterListModelHasFilter
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "item-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- 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 :: o -> m GType
getFilterListModelItemType obj :: o
obj = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "item-type"

-- | Construct a `GValueConstruct` with valid value for the “@item-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFilterListModelItemType :: (IsFilterListModel o) => GType -> IO (GValueConstruct o)
constructFilterListModelItemType :: GType -> IO (GValueConstruct o)
constructFilterListModelItemType val :: GType
val = String -> GType -> IO (GValueConstruct o)
forall o. String -> GType -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGType "item-type" GType
val

#if defined(ENABLE_OVERLOADING)
data FilterListModelItemTypePropertyInfo
instance AttrInfo FilterListModelItemTypePropertyInfo where
    type AttrAllowedOps FilterListModelItemTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FilterListModelItemTypePropertyInfo = IsFilterListModel
    type AttrSetTypeConstraint FilterListModelItemTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint FilterListModelItemTypePropertyInfo = (~) GType
    type AttrTransferType FilterListModelItemTypePropertyInfo = GType
    type AttrGetType FilterListModelItemTypePropertyInfo = GType
    type AttrLabel FilterListModelItemTypePropertyInfo = "item-type"
    type AttrOrigin FilterListModelItemTypePropertyInfo = FilterListModel
    attrGet = getFilterListModelItemType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFilterListModelItemType
    attrClear = undefined
#endif

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Gio", name = "ListModel"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- 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 :: o -> m (Maybe ListModel)
getFilterListModelModel obj :: o
obj = IO (Maybe ListModel) -> m (Maybe ListModel)
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
$ 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 "model" ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel

-- | 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, Gio.ListModel.IsListModel a) => a -> IO (GValueConstruct o)
constructFilterListModelModel :: a -> IO (GValueConstruct o)
constructFilterListModelModel val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data FilterListModelModelPropertyInfo
instance AttrInfo FilterListModelModelPropertyInfo where
    type AttrAllowedOps FilterListModelModelPropertyInfo = '[ '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 = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructFilterListModelModel
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FilterListModel
type instance O.AttributeList FilterListModel = FilterListModelAttributeList
type FilterListModelAttributeList = ('[ '("hasFilter", FilterListModelHasFilterPropertyInfo), '("itemType", FilterListModelItemTypePropertyInfo), '("model", FilterListModelModelPropertyInfo)] :: [(Symbol, *)])
#endif

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

filterListModelModel :: AttrLabelProxy "model"
filterListModelModel = AttrLabelProxy

#endif

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

#endif

-- method FilterListModel::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the model to sort" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "FilterListModelFilterFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filter function or %NULL to not filter items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @filter_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- 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"})
    FunPtr Gtk.Callbacks.C_FilterListModelFilterFunc -> -- filter_func : TInterface (Name {namespace = "Gtk", name = "FilterListModelFilterFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr FilterListModel)

-- | Creates a new t'GI.Gtk.Objects.FilterListModel.FilterListModel' that will filter /@model@/ using the given
-- /@filterFunc@/.
filterListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    a
    -- ^ /@model@/: the model to sort
    -> Maybe (Gtk.Callbacks.FilterListModelFilterFunc)
    -- ^ /@filterFunc@/: filter function or 'P.Nothing' to not filter items
    -> m FilterListModel
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.FilterListModel.FilterListModel'
filterListModelNew :: a -> Maybe FilterListModelFilterFunc -> m FilterListModel
filterListModelNew model :: a
model filterFunc :: Maybe FilterListModelFilterFunc
filterFunc = IO FilterListModel -> m FilterListModel
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
model' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    FunPtr C_FilterListModelFilterFunc
maybeFilterFunc <- case Maybe FilterListModelFilterFunc
filterFunc of
        Nothing -> FunPtr C_FilterListModelFilterFunc
-> IO (FunPtr C_FilterListModelFilterFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_FilterListModelFilterFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jFilterFunc :: FilterListModelFilterFunc
jFilterFunc -> do
            FunPtr C_FilterListModelFilterFunc
jFilterFunc' <- C_FilterListModelFilterFunc
-> IO (FunPtr C_FilterListModelFilterFunc)
Gtk.Callbacks.mk_FilterListModelFilterFunc (Maybe (Ptr (FunPtr C_FilterListModelFilterFunc))
-> FilterListModelFilterFunc_WithClosures
-> C_FilterListModelFilterFunc
Gtk.Callbacks.wrap_FilterListModelFilterFunc Maybe (Ptr (FunPtr C_FilterListModelFilterFunc))
forall a. Maybe a
Nothing (FilterListModelFilterFunc -> FilterListModelFilterFunc_WithClosures
Gtk.Callbacks.drop_closures_FilterListModelFilterFunc FilterListModelFilterFunc
jFilterFunc))
            FunPtr C_FilterListModelFilterFunc
-> IO (FunPtr C_FilterListModelFilterFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_FilterListModelFilterFunc
jFilterFunc'
    let userData :: Ptr ()
userData = FunPtr C_FilterListModelFilterFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FilterListModelFilterFunc
maybeFilterFunc
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr FilterListModel
result <- Ptr ListModel
-> FunPtr C_FilterListModelFilterFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr FilterListModel)
gtk_filter_list_model_new Ptr ListModel
model' FunPtr C_FilterListModelFilterFunc
maybeFilterFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    Text -> Ptr FilterListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    FilterListModel -> IO FilterListModel
forall (m :: * -> *) a. Monad m => a -> m a
return FilterListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FilterListModel::new_for_type
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "item_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of the items that will be returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "FilterListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_filter_list_model_new_for_type" gtk_filter_list_model_new_for_type :: 
    CGType ->                               -- item_type : TBasicType TGType
    IO (Ptr FilterListModel)

-- | Creates a new empty filter list model set up to return items of type /@itemType@/.
-- It is up to the application to set a proper filter function and model to ensure
-- the item type is matched.
filterListModelNewForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@itemType@/: the type of the items that will be returned
    -> m FilterListModel
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.FilterListModel.FilterListModel'
filterListModelNewForType :: GType -> m FilterListModel
filterListModelNewForType itemType :: GType
itemType = IO FilterListModel -> m FilterListModel
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
    let itemType' :: CGType
itemType' = GType -> CGType
gtypeToCGType GType
itemType
    Ptr FilterListModel
result <- CGType -> IO (Ptr FilterListModel)
gtk_filter_list_model_new_for_type CGType
itemType'
    Text -> Ptr FilterListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "filterListModelNewForType" 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
    FilterListModel -> IO FilterListModel
forall (m :: * -> *) a. Monad m => a -> m a
return FilterListModel
result'

#if defined(ENABLE_OVERLOADING)
#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 t'GI.Gtk.Objects.FilterListModel.FilterListModel'
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model that gets filtered
filterListModelGetModel :: a -> m (Maybe ListModel)
filterListModelGetModel self :: a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
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
$ \result' :: 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 (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 (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.MethodInfo FilterListModelGetModelMethodInfo a signature where
    overloadedMethod = filterListModelGetModel

#endif

-- method FilterListModel::has_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 (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | Checks if a filter function is currently set on /@self@/
filterListModelHasFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.FilterListModel.FilterListModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a filter function is set
filterListModelHasFilter :: a -> m Bool
filterListModelHasFilter self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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_has_filter Ptr FilterListModel
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FilterListModelHasFilterMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFilterListModel a) => O.MethodInfo FilterListModelHasFilterMethodInfo a signature where
    overloadedMethod = filterListModelHasFilter

#endif

-- method FilterListModel::refilter
-- 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: Nothing
-- throws : False
-- Skip return : False

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

-- | Causes /@self@/ to refilter all items in the model.
-- 
-- Calling this function is necessary when data used by the filter
-- function has changed.
filterListModelRefilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.FilterListModel.FilterListModel'
    -> m ()
filterListModelRefilter :: a -> m ()
filterListModelRefilter self :: a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr FilterListModel -> IO ()
gtk_filter_list_model_refilter Ptr FilterListModel
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FilterListModelRefilterMethodInfo
instance (signature ~ (m ()), MonadIO m, IsFilterListModel a) => O.MethodInfo FilterListModelRefilterMethodInfo a signature where
    overloadedMethod = filterListModelRefilter

#endif

-- method FilterListModel::set_filter_func
-- 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_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "FilterListModelFilterFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filter function or %NULL to not filter items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @filter_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , 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_func" gtk_filter_list_model_set_filter_func :: 
    Ptr FilterListModel ->                  -- self : TInterface (Name {namespace = "Gtk", name = "FilterListModel"})
    FunPtr Gtk.Callbacks.C_FilterListModelFilterFunc -> -- filter_func : TInterface (Name {namespace = "Gtk", name = "FilterListModelFilterFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the function used to filter items. The function will be called for every
-- item and if it returns 'P.True' the item is considered visible.
filterListModelSetFilterFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.FilterListModel.FilterListModel'
    -> Maybe (Gtk.Callbacks.FilterListModelFilterFunc)
    -- ^ /@filterFunc@/: filter function or 'P.Nothing' to not filter items
    -> m ()
filterListModelSetFilterFunc :: a -> Maybe FilterListModelFilterFunc -> m ()
filterListModelSetFilterFunc self :: a
self filterFunc :: Maybe FilterListModelFilterFunc
filterFunc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FilterListModel
self' <- a -> IO (Ptr FilterListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    FunPtr C_FilterListModelFilterFunc
maybeFilterFunc <- case Maybe FilterListModelFilterFunc
filterFunc of
        Nothing -> FunPtr C_FilterListModelFilterFunc
-> IO (FunPtr C_FilterListModelFilterFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_FilterListModelFilterFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jFilterFunc :: FilterListModelFilterFunc
jFilterFunc -> do
            FunPtr C_FilterListModelFilterFunc
jFilterFunc' <- C_FilterListModelFilterFunc
-> IO (FunPtr C_FilterListModelFilterFunc)
Gtk.Callbacks.mk_FilterListModelFilterFunc (Maybe (Ptr (FunPtr C_FilterListModelFilterFunc))
-> FilterListModelFilterFunc_WithClosures
-> C_FilterListModelFilterFunc
Gtk.Callbacks.wrap_FilterListModelFilterFunc Maybe (Ptr (FunPtr C_FilterListModelFilterFunc))
forall a. Maybe a
Nothing (FilterListModelFilterFunc -> FilterListModelFilterFunc_WithClosures
Gtk.Callbacks.drop_closures_FilterListModelFilterFunc FilterListModelFilterFunc
jFilterFunc))
            FunPtr C_FilterListModelFilterFunc
-> IO (FunPtr C_FilterListModelFilterFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_FilterListModelFilterFunc
jFilterFunc'
    let userData :: Ptr ()
userData = FunPtr C_FilterListModelFilterFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FilterListModelFilterFunc
maybeFilterFunc
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr FilterListModel
-> FunPtr C_FilterListModelFilterFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gtk_filter_list_model_set_filter_func Ptr FilterListModel
self' FunPtr C_FilterListModelFilterFunc
maybeFilterFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FilterListModelSetFilterFuncMethodInfo
instance (signature ~ (Maybe (Gtk.Callbacks.FilterListModelFilterFunc) -> m ()), MonadIO m, IsFilterListModel a) => O.MethodInfo FilterListModelSetFilterFuncMethodInfo a signature where
    overloadedMethod = filterListModelSetFilterFunc

#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 function to ensure
-- that item types match.
filterListModelSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsFilterListModel a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.FilterListModel.FilterListModel'
    -> Maybe (b)
    -- ^ /@model@/: The model to be filtered
    -> m ()
filterListModelSetModel :: a -> Maybe b -> m ()
filterListModelSetModel self :: a
self model :: Maybe b
model = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just jModel :: b
jModel -> do
            Ptr ListModel
jModel' <- b -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr 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 (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.MethodInfo FilterListModelSetModelMethodInfo a signature where
    overloadedMethod = filterListModelSetModel

#endif