{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Dazzle.Objects.ListModelFilter
(
ListModelFilter(..) ,
IsListModelFilter ,
toListModelFilter ,
#if defined(ENABLE_OVERLOADING)
ResolveListModelFilterMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ListModelFilterGetChildModelMethodInfo ,
#endif
listModelFilterGetChildModel ,
#if defined(ENABLE_OVERLOADING)
ListModelFilterInvalidateMethodInfo ,
#endif
listModelFilterInvalidate ,
listModelFilterNew ,
#if defined(ENABLE_OVERLOADING)
ListModelFilterSetFilterFuncMethodInfo ,
#endif
listModelFilterSetFilterFunc ,
#if defined(ENABLE_OVERLOADING)
ListModelFilterChildModelPropertyInfo ,
#endif
getListModelFilterChildModel ,
#if defined(ENABLE_OVERLOADING)
listModelFilterChildModel ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
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
#else
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
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
#endif
newtype ListModelFilter = ListModelFilter (SP.ManagedPtr ListModelFilter)
deriving (ListModelFilter -> ListModelFilter -> Bool
(ListModelFilter -> ListModelFilter -> Bool)
-> (ListModelFilter -> ListModelFilter -> Bool)
-> Eq ListModelFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListModelFilter -> ListModelFilter -> Bool
== :: ListModelFilter -> ListModelFilter -> Bool
$c/= :: ListModelFilter -> ListModelFilter -> Bool
/= :: ListModelFilter -> ListModelFilter -> Bool
Eq)
instance SP.ManagedPtrNewtype ListModelFilter where
toManagedPtr :: ListModelFilter -> ManagedPtr ListModelFilter
toManagedPtr (ListModelFilter ManagedPtr ListModelFilter
p) = ManagedPtr ListModelFilter
p
foreign import ccall "dzl_list_model_filter_get_type"
c_dzl_list_model_filter_get_type :: IO B.Types.GType
instance B.Types.TypedObject ListModelFilter where
glibType :: IO GType
glibType = IO GType
c_dzl_list_model_filter_get_type
instance B.Types.GObject ListModelFilter
class (SP.GObject o, O.IsDescendantOf ListModelFilter o) => IsListModelFilter o
instance (SP.GObject o, O.IsDescendantOf ListModelFilter o) => IsListModelFilter o
instance O.HasParentTypes ListModelFilter
type instance O.ParentTypes ListModelFilter = '[GObject.Object.Object, Gio.ListModel.ListModel]
toListModelFilter :: (MIO.MonadIO m, IsListModelFilter o) => o -> m ListModelFilter
toListModelFilter :: forall (m :: * -> *) o.
(MonadIO m, IsListModelFilter o) =>
o -> m ListModelFilter
toListModelFilter = IO ListModelFilter -> m ListModelFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ListModelFilter -> m ListModelFilter)
-> (o -> IO ListModelFilter) -> o -> m ListModelFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ListModelFilter -> ListModelFilter)
-> o -> IO ListModelFilter
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ListModelFilter -> ListModelFilter
ListModelFilter
instance B.GValue.IsGValue (Maybe ListModelFilter) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_list_model_filter_get_type
gvalueSet_ :: Ptr GValue -> Maybe ListModelFilter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ListModelFilter
P.Nothing = Ptr GValue -> Ptr ListModelFilter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ListModelFilter
forall a. Ptr a
FP.nullPtr :: FP.Ptr ListModelFilter)
gvalueSet_ Ptr GValue
gv (P.Just ListModelFilter
obj) = ListModelFilter -> (Ptr ListModelFilter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ListModelFilter
obj (Ptr GValue -> Ptr ListModelFilter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe ListModelFilter)
gvalueGet_ Ptr GValue
gv = do
Ptr ListModelFilter
ptr <- Ptr GValue -> IO (Ptr ListModelFilter)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ListModelFilter)
if Ptr ListModelFilter
ptr Ptr ListModelFilter -> Ptr ListModelFilter -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ListModelFilter
forall a. Ptr a
FP.nullPtr
then ListModelFilter -> Maybe ListModelFilter
forall a. a -> Maybe a
P.Just (ListModelFilter -> Maybe ListModelFilter)
-> IO ListModelFilter -> IO (Maybe ListModelFilter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ListModelFilter -> ListModelFilter)
-> Ptr ListModelFilter -> IO ListModelFilter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ListModelFilter -> ListModelFilter
ListModelFilter Ptr ListModelFilter
ptr
else Maybe ListModelFilter -> IO (Maybe ListModelFilter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModelFilter
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveListModelFilterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveListModelFilterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveListModelFilterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveListModelFilterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveListModelFilterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveListModelFilterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveListModelFilterMethod "invalidate" o = ListModelFilterInvalidateMethodInfo
ResolveListModelFilterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveListModelFilterMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
ResolveListModelFilterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveListModelFilterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveListModelFilterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveListModelFilterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveListModelFilterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveListModelFilterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveListModelFilterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveListModelFilterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveListModelFilterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveListModelFilterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveListModelFilterMethod "getChildModel" o = ListModelFilterGetChildModelMethodInfo
ResolveListModelFilterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveListModelFilterMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
ResolveListModelFilterMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
ResolveListModelFilterMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
ResolveListModelFilterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveListModelFilterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveListModelFilterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveListModelFilterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveListModelFilterMethod "setFilterFunc" o = ListModelFilterSetFilterFuncMethodInfo
ResolveListModelFilterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveListModelFilterMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveListModelFilterMethod t ListModelFilter, O.OverloadedMethod info ListModelFilter p) => OL.IsLabel t (ListModelFilter -> 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 ~ ResolveListModelFilterMethod t ListModelFilter, O.OverloadedMethod info ListModelFilter p, R.HasField t ListModelFilter p) => R.HasField t ListModelFilter p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveListModelFilterMethod t ListModelFilter, O.OverloadedMethodInfo info ListModelFilter) => OL.IsLabel t (O.MethodProxy info ListModelFilter) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getListModelFilterChildModel :: (MonadIO m, IsListModelFilter o) => o -> m Gio.ListModel.ListModel
getListModelFilterChildModel :: forall (m :: * -> *) o.
(MonadIO m, IsListModelFilter o) =>
o -> m ListModel
getListModelFilterChildModel o
obj = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe ListModel) -> IO ListModel
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getListModelFilterChildModel" (IO (Maybe ListModel) -> IO ListModel)
-> IO (Maybe ListModel) -> IO ListModel
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ListModel -> ListModel)
-> IO (Maybe ListModel)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"child-model" ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel
#if defined(ENABLE_OVERLOADING)
data ListModelFilterChildModelPropertyInfo
instance AttrInfo ListModelFilterChildModelPropertyInfo where
type AttrAllowedOps ListModelFilterChildModelPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ListModelFilterChildModelPropertyInfo = IsListModelFilter
type AttrSetTypeConstraint ListModelFilterChildModelPropertyInfo = (~) ()
type AttrTransferTypeConstraint ListModelFilterChildModelPropertyInfo = (~) ()
type AttrTransferType ListModelFilterChildModelPropertyInfo = ()
type AttrGetType ListModelFilterChildModelPropertyInfo = Gio.ListModel.ListModel
type AttrLabel ListModelFilterChildModelPropertyInfo = "child-model"
type AttrOrigin ListModelFilterChildModelPropertyInfo = ListModelFilter
attrGet = getListModelFilterChildModel
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ListModelFilter.childModel"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ListModelFilter.html#g:attr:childModel"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ListModelFilter
type instance O.AttributeList ListModelFilter = ListModelFilterAttributeList
type ListModelFilterAttributeList = ('[ '("childModel", ListModelFilterChildModelPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
listModelFilterChildModel :: AttrLabelProxy "childModel"
listModelFilterChildModel = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ListModelFilter = ListModelFilterSignalList
type ListModelFilterSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "dzl_list_model_filter_new" dzl_list_model_filter_new ::
Ptr Gio.ListModel.ListModel ->
IO (Ptr ListModelFilter)
listModelFilterNew ::
(B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
a
-> m ListModelFilter
listModelFilterNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
a -> m ListModelFilter
listModelFilterNew a
childModel = IO ListModelFilter -> m ListModelFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModelFilter -> m ListModelFilter)
-> IO ListModelFilter -> m ListModelFilter
forall a b. (a -> b) -> a -> b
$ do
Ptr ListModel
childModel' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
childModel
Ptr ListModelFilter
result <- Ptr ListModel -> IO (Ptr ListModelFilter)
dzl_list_model_filter_new Ptr ListModel
childModel'
Text -> Ptr ListModelFilter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"listModelFilterNew" Ptr ListModelFilter
result
ListModelFilter
result' <- ((ManagedPtr ListModelFilter -> ListModelFilter)
-> Ptr ListModelFilter -> IO ListModelFilter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModelFilter -> ListModelFilter
ListModelFilter) Ptr ListModelFilter
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
childModel
ListModelFilter -> IO ListModelFilter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModelFilter
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "dzl_list_model_filter_get_child_model" dzl_list_model_filter_get_child_model ::
Ptr ListModelFilter ->
IO (Ptr Gio.ListModel.ListModel)
listModelFilterGetChildModel ::
(B.CallStack.HasCallStack, MonadIO m, IsListModelFilter a) =>
a
-> m Gio.ListModel.ListModel
listModelFilterGetChildModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModelFilter a) =>
a -> m ListModel
listModelFilterGetChildModel a
self = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
Ptr ListModelFilter
self' <- a -> IO (Ptr ListModelFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr ListModel
result <- Ptr ListModelFilter -> IO (Ptr ListModel)
dzl_list_model_filter_get_child_model Ptr ListModelFilter
self'
Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"listModelFilterGetChildModel" Ptr ListModel
result
ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'
#if defined(ENABLE_OVERLOADING)
data ListModelFilterGetChildModelMethodInfo
instance (signature ~ (m Gio.ListModel.ListModel), MonadIO m, IsListModelFilter a) => O.OverloadedMethod ListModelFilterGetChildModelMethodInfo a signature where
overloadedMethod = listModelFilterGetChildModel
instance O.OverloadedMethodInfo ListModelFilterGetChildModelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ListModelFilter.listModelFilterGetChildModel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ListModelFilter.html#v:listModelFilterGetChildModel"
})
#endif
foreign import ccall "dzl_list_model_filter_invalidate" dzl_list_model_filter_invalidate ::
Ptr ListModelFilter ->
IO ()
listModelFilterInvalidate ::
(B.CallStack.HasCallStack, MonadIO m, IsListModelFilter a) =>
a
-> m ()
listModelFilterInvalidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModelFilter a) =>
a -> m ()
listModelFilterInvalidate a
self = 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 ListModelFilter
self' <- a -> IO (Ptr ListModelFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr ListModelFilter -> IO ()
dzl_list_model_filter_invalidate Ptr ListModelFilter
self'
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 ListModelFilterInvalidateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsListModelFilter a) => O.OverloadedMethod ListModelFilterInvalidateMethodInfo a signature where
overloadedMethod = listModelFilterInvalidate
instance O.OverloadedMethodInfo ListModelFilterInvalidateMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ListModelFilter.listModelFilterInvalidate",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ListModelFilter.html#v:listModelFilterInvalidate"
})
#endif
foreign import ccall "dzl_list_model_filter_set_filter_func" dzl_list_model_filter_set_filter_func ::
Ptr ListModelFilter ->
FunPtr Dazzle.Callbacks.C_ListModelFilterFunc ->
Ptr () ->
FunPtr GLib.Callbacks.C_DestroyNotify ->
IO ()
listModelFilterSetFilterFunc ::
(B.CallStack.HasCallStack, MonadIO m, IsListModelFilter a) =>
a
-> Dazzle.Callbacks.ListModelFilterFunc
-> m ()
listModelFilterSetFilterFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModelFilter a) =>
a -> ListModelFilterFunc -> m ()
listModelFilterSetFilterFunc a
self ListModelFilterFunc
filterFunc = 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 ListModelFilter
self' <- a -> IO (Ptr ListModelFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
FunPtr C_ListModelFilterFunc
filterFunc' <- C_ListModelFilterFunc -> IO (FunPtr C_ListModelFilterFunc)
Dazzle.Callbacks.mk_ListModelFilterFunc (Maybe (Ptr (FunPtr C_ListModelFilterFunc))
-> ListModelFilterFunc_WithClosures -> C_ListModelFilterFunc
Dazzle.Callbacks.wrap_ListModelFilterFunc Maybe (Ptr (FunPtr C_ListModelFilterFunc))
forall a. Maybe a
Nothing (ListModelFilterFunc -> ListModelFilterFunc_WithClosures
Dazzle.Callbacks.drop_closures_ListModelFilterFunc ListModelFilterFunc
filterFunc))
let filterFuncData :: Ptr ()
filterFuncData = FunPtr C_ListModelFilterFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ListModelFilterFunc
filterFunc'
let filterFuncDataDestroy :: FunPtr (Ptr a -> IO ())
filterFuncDataDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
Ptr ListModelFilter
-> FunPtr C_ListModelFilterFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
dzl_list_model_filter_set_filter_func Ptr ListModelFilter
self' FunPtr C_ListModelFilterFunc
filterFunc' Ptr ()
filterFuncData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
filterFuncDataDestroy
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 ListModelFilterSetFilterFuncMethodInfo
instance (signature ~ (Dazzle.Callbacks.ListModelFilterFunc -> m ()), MonadIO m, IsListModelFilter a) => O.OverloadedMethod ListModelFilterSetFilterFuncMethodInfo a signature where
overloadedMethod = listModelFilterSetFilterFunc
instance O.OverloadedMethodInfo ListModelFilterSetFilterFuncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ListModelFilter.listModelFilterSetFilterFunc",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ListModelFilter.html#v:listModelFilterSetFilterFunc"
})
#endif