{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GListModel@ that sorts the elements of an underlying model
-- according to a @GtkSorter@.
-- 
-- The model is a stable sort. If two items compare equal according
-- to the sorter, the one that appears first in the original model will
-- also appear first after sorting.
-- Note that if you change the sorter, the previous order will have no
-- influence on the new order. If you want that, consider using a
-- @GtkMultiSorter@ and appending the previous sorter to it.
-- 
-- The model can be set up to do incremental sorting, so that
-- sorting long lists doesn\'t block the UI. See
-- 'GI.Gtk.Objects.SortListModel.sortListModelSetIncremental' for details.
-- 
-- @GtkSortListModel@ 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 @GtkSortListModel@,
-- 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                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIncremental]("GI.Gtk.Objects.SortListModel#g:method:getIncremental"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getModel]("GI.Gtk.Objects.SortListModel#g:method:getModel"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getPending]("GI.Gtk.Objects.SortListModel#g:method:getPending"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSorter]("GI.Gtk.Objects.SortListModel#g:method:getSorter").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIncremental]("GI.Gtk.Objects.SortListModel#g:method:setIncremental"), [setModel]("GI.Gtk.Objects.SortListModel#g:method:setModel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSorter]("GI.Gtk.Objects.SortListModel#g:method:setSorter").

#if defined(ENABLE_OVERLOADING)
    ResolveSortListModelMethod              ,
#endif

-- ** getIncremental #method:getIncremental#

#if defined(ENABLE_OVERLOADING)
    SortListModelGetIncrementalMethodInfo   ,
#endif
    sortListModelGetIncremental             ,


-- ** getModel #method:getModel#

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


-- ** getPending #method:getPending#

#if defined(ENABLE_OVERLOADING)
    SortListModelGetPendingMethodInfo       ,
#endif
    sortListModelGetPending                 ,


-- ** getSorter #method:getSorter#

#if defined(ENABLE_OVERLOADING)
    SortListModelGetSorterMethodInfo        ,
#endif
    sortListModelGetSorter                  ,


-- ** new #method:new#

    sortListModelNew                        ,


-- ** setIncremental #method:setIncremental#

#if defined(ENABLE_OVERLOADING)
    SortListModelSetIncrementalMethodInfo   ,
#endif
    sortListModelSetIncremental             ,


-- ** setModel #method:setModel#

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


-- ** setSorter #method:setSorter#

#if defined(ENABLE_OVERLOADING)
    SortListModelSetSorterMethodInfo        ,
#endif
    sortListModelSetSorter                  ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    SortListModelIncrementalPropertyInfo    ,
#endif
    constructSortListModelIncremental       ,
    getSortListModelIncremental             ,
    setSortListModelIncremental             ,
#if defined(ENABLE_OVERLOADING)
    sortListModelIncremental                ,
#endif


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

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


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

#if defined(ENABLE_OVERLOADING)
    SortListModelModelPropertyInfo          ,
#endif
    clearSortListModelModel                 ,
    constructSortListModelModel             ,
    getSortListModelModel                   ,
    setSortListModelModel                   ,
#if defined(ENABLE_OVERLOADING)
    sortListModelModel                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SortListModelNItemsPropertyInfo         ,
#endif
    getSortListModelNItems                  ,
#if defined(ENABLE_OVERLOADING)
    sortListModelNItems                     ,
#endif


-- ** pending #attr:pending#
-- | Estimate of unsorted items remaining.

#if defined(ENABLE_OVERLOADING)
    SortListModelPendingPropertyInfo        ,
#endif
    getSortListModelPending                 ,
#if defined(ENABLE_OVERLOADING)
    sortListModelPending                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SortListModelSorterPropertyInfo         ,
#endif
    clearSortListModelSorter                ,
    constructSortListModelSorter            ,
    getSortListModelSorter                  ,
    setSortListModelSorter                  ,
#if defined(ENABLE_OVERLOADING)
    sortListModelSorter                     ,
#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.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import {-# SOURCE #-} qualified GI.Gtk.Objects.Sorter as Gtk.Sorter

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

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

foreign import ccall "gtk_sort_list_model_get_type"
    c_gtk_sort_list_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject SortListModel where
    glibType :: IO GType
glibType = IO GType
c_gtk_sort_list_model_get_type

instance B.Types.GObject SortListModel

-- | Type class for types which can be safely cast to `SortListModel`, for instance with `toSortListModel`.
class (SP.GObject o, O.IsDescendantOf SortListModel o) => IsSortListModel o
instance (SP.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 :: (MIO.MonadIO m, IsSortListModel o) => o -> m SortListModel
toSortListModel :: forall (m :: * -> *) o.
(MonadIO m, IsSortListModel o) =>
o -> m SortListModel
toSortListModel = IO SortListModel -> m SortListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SortListModel -> SortListModel
SortListModel

-- | Convert 'SortListModel' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SortListModel) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_sort_list_model_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SortListModel -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SortListModel
P.Nothing = Ptr GValue -> Ptr SortListModel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SortListModel
forall a. Ptr a
FP.nullPtr :: FP.Ptr SortListModel)
    gvalueSet_ Ptr GValue
gv (P.Just SortListModel
obj) = SortListModel -> (Ptr SortListModel -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SortListModel
obj (Ptr GValue -> Ptr SortListModel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SortListModel)
gvalueGet_ Ptr GValue
gv = do
        Ptr SortListModel
ptr <- Ptr GValue -> IO (Ptr SortListModel)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SortListModel)
        if Ptr SortListModel
ptr Ptr SortListModel -> Ptr SortListModel -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SortListModel
forall a. Ptr a
FP.nullPtr
        then SortListModel -> Maybe SortListModel
forall a. a -> Maybe a
P.Just (SortListModel -> Maybe SortListModel)
-> IO SortListModel -> IO (Maybe SortListModel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe SortListModel -> IO (Maybe SortListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SortListModel
forall a. Maybe a
P.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 "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 "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 "getIncremental" o = SortListModelGetIncrementalMethodInfo
    ResolveSortListModelMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveSortListModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveSortListModelMethod "getModel" o = SortListModelGetModelMethodInfo
    ResolveSortListModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveSortListModelMethod "getPending" o = SortListModelGetPendingMethodInfo
    ResolveSortListModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSortListModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSortListModelMethod "getSorter" o = SortListModelGetSorterMethodInfo
    ResolveSortListModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSortListModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSortListModelMethod "setIncremental" o = SortListModelSetIncrementalMethodInfo
    ResolveSortListModelMethod "setModel" o = SortListModelSetModelMethodInfo
    ResolveSortListModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSortListModelMethod "setSorter" o = SortListModelSetSorterMethodInfo
    ResolveSortListModelMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSortListModelMethod t SortListModel, O.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveSortListModelMethod t SortListModel, O.OverloadedMethod info SortListModel p, R.HasField t SortListModel p) => R.HasField t SortListModel p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

-- | Get the value of the “@incremental@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sortListModel #incremental
-- @
getSortListModelIncremental :: (MonadIO m, IsSortListModel o) => o -> m Bool
getSortListModelIncremental :: forall (m :: * -> *) o.
(MonadIO m, IsSortListModel o) =>
o -> m Bool
getSortListModelIncremental o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"incremental"

-- | Set the value of the “@incremental@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sortListModel [ #incremental 'Data.GI.Base.Attributes.:=' value ]
-- @
setSortListModelIncremental :: (MonadIO m, IsSortListModel o) => o -> Bool -> m ()
setSortListModelIncremental :: forall (m :: * -> *) o.
(MonadIO m, IsSortListModel o) =>
o -> Bool -> m ()
setSortListModelIncremental o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"incremental" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@incremental@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSortListModelIncremental :: (IsSortListModel o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSortListModelIncremental :: forall o (m :: * -> *).
(IsSortListModel o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSortListModelIncremental Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"incremental" Bool
val

#if defined(ENABLE_OVERLOADING)
data SortListModelIncrementalPropertyInfo
instance AttrInfo SortListModelIncrementalPropertyInfo where
    type AttrAllowedOps SortListModelIncrementalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SortListModelIncrementalPropertyInfo = IsSortListModel
    type AttrSetTypeConstraint SortListModelIncrementalPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SortListModelIncrementalPropertyInfo = (~) Bool
    type AttrTransferType SortListModelIncrementalPropertyInfo = Bool
    type AttrGetType SortListModelIncrementalPropertyInfo = Bool
    type AttrLabel SortListModelIncrementalPropertyInfo = "incremental"
    type AttrOrigin SortListModelIncrementalPropertyInfo = SortListModel
    attrGet = getSortListModelIncremental
    attrSet = setSortListModelIncremental
    attrTransfer _ v = do
        return v
    attrConstruct = constructSortListModelIncremental
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.SortListModel.incremental"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-SortListModel.html#g:attr:incremental"
        })
#endif

-- VVV Prop "item-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@item-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sortListModel #itemType
-- @
getSortListModelItemType :: (MonadIO m, IsSortListModel o) => o -> m GType
getSortListModelItemType :: forall (m :: * -> *) o.
(MonadIO m, IsSortListModel o) =>
o -> m GType
getSortListModelItemType o
obj = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO GType
forall a. GObject a => a -> String -> IO GType
B.Properties.getObjectPropertyGType o
obj String
"item-type"

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

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

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

-- | Set the value of the “@model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sortListModel [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setSortListModelModel :: (MonadIO m, IsSortListModel o, Gio.ListModel.IsListModel a) => o -> a -> m ()
setSortListModelModel :: forall (m :: * -> *) o a.
(MonadIO m, IsSortListModel o, IsListModel a) =>
o -> a -> m ()
setSortListModelModel o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@model@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSortListModelModel :: (IsSortListModel o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructSortListModelModel :: forall o (m :: * -> *) a.
(IsSortListModel o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructSortListModelModel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"model" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@model@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #model
-- @
clearSortListModelModel :: (MonadIO m, IsSortListModel o) => o -> m ()
clearSortListModelModel :: forall (m :: * -> *) o. (MonadIO m, IsSortListModel o) => o -> m ()
clearSortListModelModel o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ListModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (Maybe ListModel
forall a. Maybe a
Nothing :: Maybe Gio.ListModel.ListModel)

#if defined(ENABLE_OVERLOADING)
data SortListModelModelPropertyInfo
instance AttrInfo SortListModelModelPropertyInfo where
    type AttrAllowedOps SortListModelModelPropertyInfo = '[ 'AttrSet, '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 = setSortListModelModel
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructSortListModelModel
    attrClear = clearSortListModelModel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.SortListModel.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-SortListModel.html#g:attr:model"
        })
#endif

-- VVV Prop "n-items"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@n-items@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sortListModel #nItems
-- @
getSortListModelNItems :: (MonadIO m, IsSortListModel o) => o -> m Word32
getSortListModelNItems :: forall (m :: * -> *) o.
(MonadIO m, IsSortListModel o) =>
o -> m Word32
getSortListModelNItems o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"n-items"

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

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

-- | Get the value of the “@pending@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sortListModel #pending
-- @
getSortListModelPending :: (MonadIO m, IsSortListModel o) => o -> m Word32
getSortListModelPending :: forall (m :: * -> *) o.
(MonadIO m, IsSortListModel o) =>
o -> m Word32
getSortListModelPending o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"pending"

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

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

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

-- | Set the value of the “@sorter@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sortListModel [ #sorter 'Data.GI.Base.Attributes.:=' value ]
-- @
setSortListModelSorter :: (MonadIO m, IsSortListModel o, Gtk.Sorter.IsSorter a) => o -> a -> m ()
setSortListModelSorter :: forall (m :: * -> *) o a.
(MonadIO m, IsSortListModel o, IsSorter a) =>
o -> a -> m ()
setSortListModelSorter o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"sorter" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@sorter@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSortListModelSorter :: (IsSortListModel o, MIO.MonadIO m, Gtk.Sorter.IsSorter a) => a -> m (GValueConstruct o)
constructSortListModelSorter :: forall o (m :: * -> *) a.
(IsSortListModel o, MonadIO m, IsSorter a) =>
a -> m (GValueConstruct o)
constructSortListModelSorter a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"sorter" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@sorter@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #sorter
-- @
clearSortListModelSorter :: (MonadIO m, IsSortListModel o) => o -> m ()
clearSortListModelSorter :: forall (m :: * -> *) o. (MonadIO m, IsSortListModel o) => o -> m ()
clearSortListModelSorter o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Sorter -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"sorter" (Maybe Sorter
forall a. Maybe a
Nothing :: Maybe Gtk.Sorter.Sorter)

#if defined(ENABLE_OVERLOADING)
data SortListModelSorterPropertyInfo
instance AttrInfo SortListModelSorterPropertyInfo where
    type AttrAllowedOps SortListModelSorterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SortListModelSorterPropertyInfo = IsSortListModel
    type AttrSetTypeConstraint SortListModelSorterPropertyInfo = Gtk.Sorter.IsSorter
    type AttrTransferTypeConstraint SortListModelSorterPropertyInfo = Gtk.Sorter.IsSorter
    type AttrTransferType SortListModelSorterPropertyInfo = Gtk.Sorter.Sorter
    type AttrGetType SortListModelSorterPropertyInfo = (Maybe Gtk.Sorter.Sorter)
    type AttrLabel SortListModelSorterPropertyInfo = "sorter"
    type AttrOrigin SortListModelSorterPropertyInfo = SortListModel
    attrGet = getSortListModelSorter
    attrSet = setSortListModelSorter
    attrTransfer _ v = do
        unsafeCastTo Gtk.Sorter.Sorter v
    attrConstruct = constructSortListModelSorter
    attrClear = clearSortListModelSorter
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.SortListModel.sorter"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-SortListModel.html#g:attr:sorter"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SortListModel
type instance O.AttributeList SortListModel = SortListModelAttributeList
type SortListModelAttributeList = ('[ '("incremental", SortListModelIncrementalPropertyInfo), '("itemType", SortListModelItemTypePropertyInfo), '("model", SortListModelModelPropertyInfo), '("nItems", SortListModelNItemsPropertyInfo), '("pending", SortListModelPendingPropertyInfo), '("sorter", SortListModelSorterPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
sortListModelIncremental :: AttrLabelProxy "incremental"
sortListModelIncremental = AttrLabelProxy

sortListModelItemType :: AttrLabelProxy "itemType"
sortListModelItemType = AttrLabelProxy

sortListModelModel :: AttrLabelProxy "model"
sortListModelModel = AttrLabelProxy

sortListModelNItems :: AttrLabelProxy "nItems"
sortListModelNItems = AttrLabelProxy

sortListModelPending :: AttrLabelProxy "pending"
sortListModelPending = AttrLabelProxy

sortListModelSorter :: AttrLabelProxy "sorter"
sortListModelSorter = 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the model to sort" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "sorter"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Sorter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GtkSorter` to sort @model with,"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- 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"})
    Ptr Gtk.Sorter.Sorter ->                -- sorter : TInterface (Name {namespace = "Gtk", name = "Sorter"})
    IO (Ptr SortListModel)

-- | Creates a new sort list model that uses the /@sorter@/ to sort /@model@/.
sortListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a, Gtk.Sorter.IsSorter b) =>
    Maybe (a)
    -- ^ /@model@/: the model to sort
    -> Maybe (b)
    -- ^ /@sorter@/: the @GtkSorter@ to sort /@model@/ with,
    -> m SortListModel
    -- ^ __Returns:__ a new @GtkSortListModel@
sortListModelNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListModel a, IsSorter b) =>
Maybe a -> Maybe b -> m SortListModel
sortListModelNew Maybe a
model Maybe b
sorter = IO SortListModel -> m SortListModel
forall a. IO a -> m a
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
maybeModel <- case Maybe a
model of
        Maybe a
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just a
jModel -> do
            Ptr ListModel
jModel' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr Sorter
maybeSorter <- case Maybe b
sorter of
        Maybe b
Nothing -> Ptr Sorter -> IO (Ptr Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Sorter
forall a. Ptr a
nullPtr
        Just b
jSorter -> do
            Ptr Sorter
jSorter' <- b -> IO (Ptr Sorter)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
jSorter
            Ptr Sorter -> IO (Ptr Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Sorter
jSorter'
    Ptr SortListModel
result <- Ptr ListModel -> Ptr Sorter -> IO (Ptr SortListModel)
gtk_sort_list_model_new Ptr ListModel
maybeModel Ptr Sorter
maybeSorter
    Text -> Ptr SortListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"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
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
model a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
sorter b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    SortListModel -> IO SortListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SortListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SortListModel::get_incremental
-- 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_get_incremental" gtk_sort_list_model_get_incremental :: 
    Ptr SortListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "SortListModel"})
    IO CInt

-- | Returns whether incremental sorting is enabled.
-- 
-- See 'GI.Gtk.Objects.SortListModel.sortListModelSetIncremental'.
sortListModelGetIncremental ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a @GtkSortListModel@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if incremental sorting is enabled
sortListModelGetIncremental :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSortListModel a) =>
a -> m Bool
sortListModelGetIncremental a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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_get_incremental Ptr SortListModel
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SortListModelGetIncrementalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSortListModel a) => O.OverloadedMethod SortListModelGetIncrementalMethodInfo a signature where
    overloadedMethod = sortListModelGetIncremental

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


#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 @GtkSortListModel@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model that gets sorted
sortListModelGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSortListModel a) =>
a -> m (Maybe ListModel)
sortListModelGetModel a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
$ \Ptr ListModel
result' -> do
        ListModel
result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
        ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data SortListModelGetModelMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsSortListModel a) => O.OverloadedMethod SortListModelGetModelMethodInfo a signature where
    overloadedMethod = sortListModelGetModel

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


#endif

-- method SortListModel::get_pending
-- 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 TUInt)
-- throws : False
-- Skip return : False

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

-- | Estimates progress of an ongoing sorting operation.
-- 
-- The estimate is the number of items that would still need to be
-- sorted to finish the sorting operation if this was a linear
-- algorithm. So this number is not related to how many items are
-- already correctly sorted.
-- 
-- If you want to estimate the progress, you can use code like this:
-- 
-- === /c code/
-- >pending = gtk_sort_list_model_get_pending (self);
-- >model = gtk_sort_list_model_get_model (self);
-- >progress = 1.0 - pending / (double) MAX (1, g_list_model_get_n_items (model));
-- 
-- 
-- If no sort operation is ongoing - in particular when
-- [SortListModel:incremental]("GI.Gtk.Objects.SortListModel#g:attr:incremental") is 'P.False' - this
-- function returns 0.
sortListModelGetPending ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a @GtkSortListModel@
    -> m Word32
    -- ^ __Returns:__ a progress estimate of remaining items to sort
sortListModelGetPending :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSortListModel a) =>
a -> m Word32
sortListModelGetPending a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr SortListModel -> IO Word32
gtk_sort_list_model_get_pending Ptr SortListModel
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SortListModelGetPendingMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSortListModel a) => O.OverloadedMethod SortListModelGetPendingMethodInfo a signature where
    overloadedMethod = sortListModelGetPending

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


#endif

-- method SortListModel::get_sorter
-- 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 = "Gtk" , name = "Sorter" })
-- throws : False
-- Skip return : False

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

-- | Gets the sorter that is used to sort /@self@/.
sortListModelGetSorter ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a @GtkSortListModel@
    -> m (Maybe Gtk.Sorter.Sorter)
    -- ^ __Returns:__ the sorter of @/self/@
sortListModelGetSorter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSortListModel a) =>
a -> m (Maybe Sorter)
sortListModelGetSorter a
self = IO (Maybe Sorter) -> m (Maybe Sorter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Sorter) -> m (Maybe Sorter))
-> IO (Maybe Sorter) -> m (Maybe Sorter)
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 Sorter
result <- Ptr SortListModel -> IO (Ptr Sorter)
gtk_sort_list_model_get_sorter Ptr SortListModel
self'
    Maybe Sorter
maybeResult <- Ptr Sorter -> (Ptr Sorter -> IO Sorter) -> IO (Maybe Sorter)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Sorter
result ((Ptr Sorter -> IO Sorter) -> IO (Maybe Sorter))
-> (Ptr Sorter -> IO Sorter) -> IO (Maybe Sorter)
forall a b. (a -> b) -> a -> b
$ \Ptr Sorter
result' -> do
        Sorter
result'' <- ((ManagedPtr Sorter -> Sorter) -> Ptr Sorter -> IO Sorter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Sorter -> Sorter
Gtk.Sorter.Sorter) Ptr Sorter
result'
        Sorter -> IO Sorter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sorter
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Sorter -> IO (Maybe Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sorter
maybeResult

#if defined(ENABLE_OVERLOADING)
data SortListModelGetSorterMethodInfo
instance (signature ~ (m (Maybe Gtk.Sorter.Sorter)), MonadIO m, IsSortListModel a) => O.OverloadedMethod SortListModelGetSorterMethodInfo a signature where
    overloadedMethod = sortListModelGetSorter

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


#endif

-- method SortListModel::set_incremental
-- 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 = "incremental"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to sort incrementally"
--                 , 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_incremental" gtk_sort_list_model_set_incremental :: 
    Ptr SortListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "SortListModel"})
    CInt ->                                 -- incremental : TBasicType TBoolean
    IO ()

-- | Sets the sort model to do an incremental sort.
-- 
-- When incremental sorting is enabled, the @GtkSortListModel@ will not do
-- a complete sort immediately, but will instead queue an idle handler that
-- incrementally sorts the items towards their correct position. This of
-- course means that items do not instantly appear in the right place. It
-- also means that the total sorting time is a lot slower.
-- 
-- When your filter blocks the UI while sorting, you might consider
-- turning this on. Depending on your model and sorters, this may become
-- interesting around 10,000 to 100,000 items.
-- 
-- By default, incremental sorting is disabled.
-- 
-- See 'GI.Gtk.Objects.SortListModel.sortListModelGetPending' for progress information
-- about an ongoing incremental sorting operation.
sortListModelSetIncremental ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a) =>
    a
    -- ^ /@self@/: a @GtkSortListModel@
    -> Bool
    -- ^ /@incremental@/: 'P.True' to sort incrementally
    -> m ()
sortListModelSetIncremental :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSortListModel a) =>
a -> Bool -> m ()
sortListModelSetIncremental a
self Bool
incremental = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let incremental' :: CInt
incremental' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
incremental
    Ptr SortListModel -> CInt -> IO ()
gtk_sort_list_model_set_incremental Ptr SortListModel
self' CInt
incremental'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SortListModelSetIncrementalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSortListModel a) => O.OverloadedMethod SortListModelSetIncrementalMethodInfo a signature where
    overloadedMethod = sortListModelSetIncremental

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


#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 @GtkSortListModel@
    -> Maybe (b)
    -- ^ /@model@/: The model to be sorted
    -> m ()
sortListModelSetModel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSortListModel a, IsListModel b) =>
a -> Maybe b -> m ()
sortListModelSetModel a
self Maybe b
model = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Maybe b
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just b
jModel -> do
            Ptr ListModel
jModel' <- b -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr 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 a. a -> IO a
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.OverloadedMethod SortListModelSetModelMethodInfo a signature where
    overloadedMethod = sortListModelSetModel

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


#endif

-- method SortListModel::set_sorter
-- 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 = "sorter"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Sorter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GtkSorter` to sort @model with"
--                 , 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_sorter" gtk_sort_list_model_set_sorter :: 
    Ptr SortListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "SortListModel"})
    Ptr Gtk.Sorter.Sorter ->                -- sorter : TInterface (Name {namespace = "Gtk", name = "Sorter"})
    IO ()

-- | Sets a new sorter on /@self@/.
sortListModelSetSorter ::
    (B.CallStack.HasCallStack, MonadIO m, IsSortListModel a, Gtk.Sorter.IsSorter b) =>
    a
    -- ^ /@self@/: a @GtkSortListModel@
    -> Maybe (b)
    -- ^ /@sorter@/: the @GtkSorter@ to sort /@model@/ with
    -> m ()
sortListModelSetSorter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSortListModel a, IsSorter b) =>
a -> Maybe b -> m ()
sortListModelSetSorter a
self Maybe b
sorter = 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 SortListModel
self' <- a -> IO (Ptr SortListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Sorter
maybeSorter <- case Maybe b
sorter of
        Maybe b
Nothing -> Ptr Sorter -> IO (Ptr Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Sorter
forall a. Ptr a
nullPtr
        Just b
jSorter -> do
            Ptr Sorter
jSorter' <- b -> IO (Ptr Sorter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSorter
            Ptr Sorter -> IO (Ptr Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Sorter
jSorter'
    Ptr SortListModel -> Ptr Sorter -> IO ()
gtk_sort_list_model_set_sorter Ptr SortListModel
self' Ptr Sorter
maybeSorter
    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
sorter b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SortListModelSetSorterMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSortListModel a, Gtk.Sorter.IsSorter b) => O.OverloadedMethod SortListModelSetSorterMethodInfo a signature where
    overloadedMethod = sortListModelSetSorter

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


#endif