{-# 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.SortListModel.SortListModel' is a list model that takes a list model and
-- sorts its elements according to a compare function.
-- 
-- t'GI.Gtk.Objects.SortListModel.SortListModel' is a generic model and because of that it
-- cannot take advantage of any external knowledge when sorting.
-- If you run into performance issues with t'GI.Gtk.Objects.SortListModel.SortListModel', it
-- is strongly recommended that you write your own sorting list
-- model.

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

module GI.Gtk.Objects.SortListModel
    ( 

-- * Exported types
    SortListModel(..)                       ,
    IsSortListModel                         ,
    toSortListModel                         ,
    noSortListModel                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSortListModelMethod              ,
#endif


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    SortListModelGetModelMethodInfo         ,
#endif
    sortListModelGetModel                   ,


-- ** hasSort #method:hasSort#

#if defined(ENABLE_OVERLOADING)
    SortListModelHasSortMethodInfo          ,
#endif
    sortListModelHasSort                    ,


-- ** new #method:new#

    sortListModelNew                        ,


-- ** newForType #method:newForType#

    sortListModelNewForType                 ,


-- ** resort #method:resort#

#if defined(ENABLE_OVERLOADING)
    SortListModelResortMethodInfo           ,
#endif
    sortListModelResort                     ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    SortListModelSetModelMethodInfo         ,
#endif
    sortListModelSetModel                   ,


-- ** setSortFunc #method:setSortFunc#

#if defined(ENABLE_OVERLOADING)
    SortListModelSetSortFuncMethodInfo      ,
#endif
    sortListModelSetSortFunc                ,




 -- * Properties
-- ** hasSort #attr:hasSort#
-- | If a sort function is set for this model

#if defined(ENABLE_OVERLOADING)
    SortListModelHasSortPropertyInfo        ,
#endif
    getSortListModelHasSort                 ,


-- ** itemType #attr:itemType#
-- | The t'GType' for items of this model

#if defined(ENABLE_OVERLOADING)
    SortListModelItemTypePropertyInfo       ,
#endif
    constructSortListModelItemType          ,
    getSortListModelItemType                ,
#if defined(ENABLE_OVERLOADING)
    sortListModelItemType                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SortListModelModelPropertyInfo          ,
#endif
    constructSortListModelModel             ,
    getSortListModelModel                   ,
#if defined(ENABLE_OVERLOADING)
    sortListModelModel                      ,
#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.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

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

instance GObject SortListModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_sort_list_model_get_type
    

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

-- | Type class for types which can be safely cast to `SortListModel`, for instance with `toSortListModel`.
class (GObject o, O.IsDescendantOf SortListModel o) => IsSortListModel o
instance (GObject o, O.IsDescendantOf SortListModel o) => IsSortListModel o

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

-- | Cast to `SortListModel`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toSortListModel :: (MonadIO m, IsSortListModel o) => o -> m SortListModel
toSortListModel :: o -> m SortListModel
toSortListModel = IO SortListModel -> m SortListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SortListModel -> m SortListModel)
-> (o -> IO SortListModel) -> o -> m SortListModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SortListModel -> SortListModel)
-> o -> IO SortListModel
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr SortListModel -> SortListModel
SortListModel

-- | A convenience alias for `Nothing` :: `Maybe` `SortListModel`.
noSortListModel :: Maybe SortListModel
noSortListModel :: Maybe SortListModel
noSortListModel = Maybe SortListModel
forall a. Maybe a
Nothing

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

instance (info ~ ResolveSortListModelMethod t SortListModel, O.MethodInfo info SortListModel p) => OL.IsLabel t (SortListModel -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

-- | Get the value of the “@has-sort@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sortListModel #hasSort
-- @
getSortListModelHasSort :: (MonadIO m, IsSortListModel o) => o -> m Bool
getSortListModelHasSort :: o -> m Bool
getSortListModelHasSort 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-sort"

#if defined(ENABLE_OVERLOADING)
data SortListModelHasSortPropertyInfo
instance AttrInfo SortListModelHasSortPropertyInfo where
    type AttrAllowedOps SortListModelHasSortPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SortListModelHasSortPropertyInfo = IsSortListModel
    type AttrSetTypeConstraint SortListModelHasSortPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SortListModelHasSortPropertyInfo = (~) ()
    type AttrTransferType SortListModelHasSortPropertyInfo = ()
    type AttrGetType SortListModelHasSortPropertyInfo = Bool
    type AttrLabel SortListModelHasSortPropertyInfo = "has-sort"
    type AttrOrigin SortListModelHasSortPropertyInfo = SortListModel
    attrGet = getSortListModelHasSort
    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' sortListModel #itemType
-- @
getSortListModelItemType :: (MonadIO m, IsSortListModel o) => o -> m GType
getSortListModelItemType :: o -> m GType
getSortListModelItemType 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`.
constructSortListModelItemType :: (IsSortListModel o) => GType -> IO (GValueConstruct o)
constructSortListModelItemType :: GType -> IO (GValueConstruct o)
constructSortListModelItemType 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 SortListModelItemTypePropertyInfo
instance AttrInfo SortListModelItemTypePropertyInfo where
    type AttrAllowedOps SortListModelItemTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SortListModelItemTypePropertyInfo = IsSortListModel
    type AttrSetTypeConstraint SortListModelItemTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint SortListModelItemTypePropertyInfo = (~) GType
    type AttrTransferType SortListModelItemTypePropertyInfo = GType
    type AttrGetType SortListModelItemTypePropertyInfo = GType
    type AttrLabel SortListModelItemTypePropertyInfo = "item-type"
    type AttrOrigin SortListModelItemTypePropertyInfo = SortListModel
    attrGet = getSortListModelItemType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructSortListModelItemType
    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' sortListModel #model
-- @
getSortListModelModel :: (MonadIO m, IsSortListModel o) => o -> m (Maybe Gio.ListModel.ListModel)
getSortListModelModel :: o -> m (Maybe ListModel)
getSortListModelModel 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`.
constructSortListModelModel :: (IsSortListModel o, Gio.ListModel.IsListModel a) => a -> IO (GValueConstruct o)
constructSortListModelModel :: a -> IO (GValueConstruct o)
constructSortListModelModel 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 SortListModelModelPropertyInfo
instance AttrInfo SortListModelModelPropertyInfo where
    type AttrAllowedOps SortListModelModelPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SortListModelModelPropertyInfo = IsSortListModel
    type AttrSetTypeConstraint SortListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint SortListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType SortListModelModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType SortListModelModelPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel SortListModelModelPropertyInfo = "model"
    type AttrOrigin SortListModelModelPropertyInfo = SortListModel
    attrGet = getSortListModelModel
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructSortListModelModel
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SortListModel
type instance O.AttributeList SortListModel = SortListModelAttributeList
type SortListModelAttributeList = ('[ '("hasSort", SortListModelHasSortPropertyInfo), '("itemType", SortListModelItemTypePropertyInfo), '("model", SortListModelModelPropertyInfo)] :: [(Symbol, *)])
#endif

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

sortListModelModel :: AttrLabelProxy "model"
sortListModelModel = AttrLabelProxy

#endif

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

#endif

-- method SortListModel::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 = "sort_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareDataFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "sort function or %NULL to not sort 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 @sort_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 = "SortListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_sort_list_model_new" gtk_sort_list_model_new :: 
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    FunPtr GLib.Callbacks.C_CompareDataFunc -> -- sort_func : TInterface (Name {namespace = "GLib", name = "CompareDataFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr SortListModel)

-- | Creates a new sort list model that uses the /@sortFunc@/ to sort /@model@/.
sortListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    a
    -- ^ /@model@/: the model to sort
    -> Maybe (GLib.Callbacks.CompareDataFunc)
    -- ^ /@sortFunc@/: sort function or 'P.Nothing' to not sort items
    -> m SortListModel
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.SortListModel.SortListModel'
sortListModelNew :: a -> Maybe CompareDataFunc -> m SortListModel
sortListModelNew model :: a
model sortFunc :: Maybe CompareDataFunc
sortFunc = IO SortListModel -> m SortListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SortListModel -> m SortListModel)
-> IO SortListModel -> m SortListModel
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_CompareDataFunc
maybeSortFunc <- case Maybe CompareDataFunc
sortFunc of
        Nothing -> FunPtr C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_CompareDataFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jSortFunc :: CompareDataFunc
jSortFunc -> do
            FunPtr C_CompareDataFunc
jSortFunc' <- C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
GLib.Callbacks.mk_CompareDataFunc (Maybe (Ptr (FunPtr C_CompareDataFunc))
-> C_CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.wrap_CompareDataFunc Maybe (Ptr (FunPtr C_CompareDataFunc))
forall a. Maybe a
Nothing (CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.drop_closures_CompareDataFunc CompareDataFunc
jSortFunc))
            FunPtr C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_CompareDataFunc
jSortFunc'
    let userData :: Ptr ()
userData = FunPtr C_CompareDataFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CompareDataFunc
maybeSortFunc
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr SortListModel
result <- Ptr ListModel
-> FunPtr C_CompareDataFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr SortListModel)
gtk_sort_list_model_new Ptr ListModel
model' FunPtr C_CompareDataFunc
maybeSortFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    Text -> Ptr SortListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "sortListModelNew" Ptr SortListModel
result
    SortListModel
result' <- ((ManagedPtr SortListModel -> SortListModel)
-> Ptr SortListModel -> IO SortListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SortListModel -> SortListModel
SortListModel) Ptr SortListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    SortListModel -> IO SortListModel
forall (m :: * -> *) a. Monad m => a -> m a
return SortListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SortListModel::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 = "SortListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_sort_list_model_new_for_type" gtk_sort_list_model_new_for_type :: 
    CGType ->                               -- item_type : TBasicType TGType
    IO (Ptr SortListModel)

-- | Creates a new empty sort list model set up to return items of type /@itemType@/.
-- It is up to the application to set a proper sort function and model to ensure
-- the item type is matched.
sortListModelNewForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@itemType@/: the type of the items that will be returned
    -> m SortListModel
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.SortListModel.SortListModel'
sortListModelNewForType :: GType -> m SortListModel
sortListModelNewForType itemType :: GType
itemType = IO SortListModel -> m SortListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SortListModel -> m SortListModel)
-> IO SortListModel -> m SortListModel
forall a b. (a -> b) -> a -> b
$ do
    let itemType' :: CGType
itemType' = GType -> CGType
gtypeToCGType GType
itemType
    Ptr SortListModel
result <- CGType -> IO (Ptr SortListModel)
gtk_sort_list_model_new_for_type CGType
itemType'
    Text -> Ptr SortListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "sortListModelNewForType" Ptr SortListModel
result
    SortListModel
result' <- ((ManagedPtr SortListModel -> SortListModel)
-> Ptr SortListModel -> IO SortListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SortListModel -> SortListModel
SortListModel) Ptr SortListModel
result
    SortListModel -> IO SortListModel
forall (m :: * -> *) a. Monad m => a -> m a
return SortListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

-- | Gets the model currently sorted or 'P.Nothing' if none.
sortListModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SortListModel.SortListModel'
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model that gets sorted
sortListModelGetModel :: a -> m (Maybe ListModel)
sortListModelGetModel 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 SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr SortListModel -> IO (Ptr ListModel)
gtk_sort_list_model_get_model Ptr SortListModel
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 SortListModelGetModelMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsSortListModel a) => O.MethodInfo SortListModelGetModelMethodInfo a signature where
    overloadedMethod = sortListModelGetModel

#endif

-- method SortListModel::has_sort
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SortListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSortListModel"
--                 , 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_sort_list_model_has_sort" gtk_sort_list_model_has_sort :: 
    Ptr SortListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "SortListModel"})
    IO CInt

-- | Checks if a sort function is currently set on /@self@/
sortListModelHasSort ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SortListModel.SortListModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a sort function is set
sortListModelHasSort :: a -> m Bool
sortListModelHasSort 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 SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr SortListModel -> IO CInt
gtk_sort_list_model_has_sort Ptr SortListModel
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 SortListModelHasSortMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSortListModel a) => O.MethodInfo SortListModelHasSortMethodInfo a signature where
    overloadedMethod = sortListModelHasSort

#endif

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

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

-- | Causes /@self@/ to resort all items in the model.
-- 
-- Calling this function is necessary when data used by the sort
-- function has changed.
sortListModelResort ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SortListModel.SortListModel'
    -> m ()
sortListModelResort :: a -> m ()
sortListModelResort 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 SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SortListModel -> IO ()
gtk_sort_list_model_resort Ptr SortListModel
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 SortListModelResortMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSortListModel a) => O.MethodInfo SortListModelResortMethodInfo a signature where
    overloadedMethod = sortListModelResort

#endif

-- method SortListModel::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SortListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSortListModel"
--                 , 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 sorted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_sort_list_model_set_model" gtk_sort_list_model_set_model :: 
    Ptr SortListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "SortListModel"})
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | Sets the model to be sorted. The /@model@/\'s item type must conform to
-- the item type of /@self@/.
sortListModelSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SortListModel.SortListModel'
    -> Maybe (b)
    -- ^ /@model@/: The model to be sorted
    -> m ()
sortListModelSetModel :: a -> Maybe b -> m ()
sortListModelSetModel 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 SortListModel
self' <- a -> IO (Ptr SortListModel)
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 SortListModel -> Ptr ListModel -> IO ()
gtk_sort_list_model_set_model Ptr SortListModel
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 SortListModelSetModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSortListModel a, Gio.ListModel.IsListModel b) => O.MethodInfo SortListModelSetModelMethodInfo a signature where
    overloadedMethod = sortListModelSetModel

#endif

-- method SortListModel::set_sort_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SortListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSortListModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sort_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareDataFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "sort function or %NULL to not sort 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 @sort_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_sort_list_model_set_sort_func" gtk_sort_list_model_set_sort_func :: 
    Ptr SortListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "SortListModel"})
    FunPtr GLib.Callbacks.C_CompareDataFunc -> -- sort_func : TInterface (Name {namespace = "GLib", name = "CompareDataFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the function used to sort items. The function will be called for every
-- item and must return an integer less than, equal to, or greater than zero if
-- for two items from the model if the first item is considered to be respectively
-- less than, equal to, or greater than the second.
sortListModelSetSortFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SortListModel.SortListModel'
    -> Maybe (GLib.Callbacks.CompareDataFunc)
    -- ^ /@sortFunc@/: sort function or 'P.Nothing' to not sort items
    -> m ()
sortListModelSetSortFunc :: a -> Maybe CompareDataFunc -> m ()
sortListModelSetSortFunc self :: a
self sortFunc :: Maybe CompareDataFunc
sortFunc = 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 SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    FunPtr C_CompareDataFunc
maybeSortFunc <- case Maybe CompareDataFunc
sortFunc of
        Nothing -> FunPtr C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_CompareDataFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jSortFunc :: CompareDataFunc
jSortFunc -> do
            FunPtr C_CompareDataFunc
jSortFunc' <- C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
GLib.Callbacks.mk_CompareDataFunc (Maybe (Ptr (FunPtr C_CompareDataFunc))
-> C_CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.wrap_CompareDataFunc Maybe (Ptr (FunPtr C_CompareDataFunc))
forall a. Maybe a
Nothing (CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.drop_closures_CompareDataFunc CompareDataFunc
jSortFunc))
            FunPtr C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_CompareDataFunc
jSortFunc'
    let userData :: Ptr ()
userData = FunPtr C_CompareDataFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CompareDataFunc
maybeSortFunc
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr SortListModel
-> FunPtr C_CompareDataFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gtk_sort_list_model_set_sort_func Ptr SortListModel
self' FunPtr C_CompareDataFunc
maybeSortFunc 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 SortListModelSetSortFuncMethodInfo
instance (signature ~ (Maybe (GLib.Callbacks.CompareDataFunc) -> m ()), MonadIO m, IsSortListModel a) => O.MethodInfo SortListModelSetSortFuncMethodInfo a signature where
    overloadedMethod = sortListModelSetSortFunc

#endif