{-# 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.Sorter.Sorter' is the way to describe sorting criteria.
-- Its primary user is t'GI.Gtk.Objects.SortListModel.SortListModel'.
-- 
-- The model will use a sorter to determine the order in which its items should appear
-- by calling 'GI.Gtk.Objects.Sorter.sorterCompare' for pairs of items.
-- 
-- Sorters may change their sorting behavior through their lifetime. In that case,
-- they will emit the [changed]("GI.Gtk.Objects.Sorter#g:signal:changed") signal to notify that the sort order is
-- no longer valid and should be updated by calling 'GI.Gtk.Objects.Sorter.sorterCompare' again.
-- 
-- GTK provides various pre-made sorter implementations for common sorting operations.
-- t'GI.Gtk.Objects.ColumnView.ColumnView' has built-in support for sorting lists via the t'GI.Gtk.Objects.ColumnViewColumn.ColumnViewColumn':@/sorter/@
-- property, where the user can change the sorting by clicking on list headers.
-- 
-- Of course, in particular for large lists, it is also possible to subclass t'GI.Gtk.Objects.Sorter.Sorter'
-- and provide one\'s own sorter.

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

module GI.Gtk.Objects.Sorter
    ( 

-- * Exported types
    Sorter(..)                              ,
    IsSorter                                ,
    toSorter                                ,


 -- * 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"), [changed]("GI.Gtk.Objects.Sorter#g:method:changed"), [compare]("GI.Gtk.Objects.Sorter#g:method:compare"), [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"), [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"), [getOrder]("GI.Gtk.Objects.Sorter#g:method:getOrder"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSorterMethod                     ,
#endif

-- ** changed #method:changed#

#if defined(ENABLE_OVERLOADING)
    SorterChangedMethodInfo                 ,
#endif
    sorterChanged                           ,


-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    SorterCompareMethodInfo                 ,
#endif
    sorterCompare                           ,


-- ** getOrder #method:getOrder#

#if defined(ENABLE_OVERLOADING)
    SorterGetOrderMethodInfo                ,
#endif
    sorterGetOrder                          ,




 -- * Signals


-- ** changed #signal:changed#

    C_SorterChangedCallback                 ,
    SorterChangedCallback                   ,
#if defined(ENABLE_OVERLOADING)
    SorterChangedSignalInfo                 ,
#endif
    afterSorterChanged                      ,
    genClosure_SorterChanged                ,
    mk_SorterChangedCallback                ,
    noSorterChangedCallback                 ,
    onSorterChanged                         ,
    wrap_SorterChangedCallback              ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums

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

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

foreign import ccall "gtk_sorter_get_type"
    c_gtk_sorter_get_type :: IO B.Types.GType

instance B.Types.TypedObject Sorter where
    glibType :: IO GType
glibType = IO GType
c_gtk_sorter_get_type

instance B.Types.GObject Sorter

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

instance O.HasParentTypes Sorter
type instance O.ParentTypes Sorter = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSorterMethod (t :: Symbol) (o :: *) :: * where
    ResolveSorterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSorterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSorterMethod "changed" o = SorterChangedMethodInfo
    ResolveSorterMethod "compare" o = SorterCompareMethodInfo
    ResolveSorterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSorterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSorterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSorterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSorterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSorterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSorterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSorterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSorterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSorterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSorterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSorterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSorterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSorterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSorterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSorterMethod "getOrder" o = SorterGetOrderMethodInfo
    ResolveSorterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSorterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSorterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSorterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSorterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSorterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Sorter::changed
-- | This signal is emitted whenever the sorter changed. Users of the sorter
-- should then update the sort order again via 'GI.Gtk.Objects.Sorter.sorterCompare'.
-- 
-- t'GI.Gtk.Objects.SortListModel.SortListModel' handles this signal automatically.
-- 
-- Depending on the /@change@/ parameter, it may be possible to update
-- the sort order without a full resorting. Refer to the t'GI.Gtk.Enums.SorterChange'
-- documentation for details.
type SorterChangedCallback =
    Gtk.Enums.SorterChange
    -- ^ /@change@/: how the sorter changed
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SorterChangedCallback`@.
noSorterChangedCallback :: Maybe SorterChangedCallback
noSorterChangedCallback :: Maybe SorterChangedCallback
noSorterChangedCallback = Maybe SorterChangedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_SorterChangedCallback =
    Ptr () ->                               -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_SorterChangedCallback`.
foreign import ccall "wrapper"
    mk_SorterChangedCallback :: C_SorterChangedCallback -> IO (FunPtr C_SorterChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_SorterChanged :: MonadIO m => SorterChangedCallback -> m (GClosure C_SorterChangedCallback)
genClosure_SorterChanged :: forall (m :: * -> *).
MonadIO m =>
SorterChangedCallback -> m (GClosure C_SorterChangedCallback)
genClosure_SorterChanged SorterChangedCallback
cb = IO (GClosure C_SorterChangedCallback)
-> m (GClosure C_SorterChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SorterChangedCallback)
 -> m (GClosure C_SorterChangedCallback))
-> IO (GClosure C_SorterChangedCallback)
-> m (GClosure C_SorterChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_SorterChangedCallback
cb' = SorterChangedCallback -> C_SorterChangedCallback
wrap_SorterChangedCallback SorterChangedCallback
cb
    C_SorterChangedCallback -> IO (FunPtr C_SorterChangedCallback)
mk_SorterChangedCallback C_SorterChangedCallback
cb' IO (FunPtr C_SorterChangedCallback)
-> (FunPtr C_SorterChangedCallback
    -> IO (GClosure C_SorterChangedCallback))
-> IO (GClosure C_SorterChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SorterChangedCallback
-> IO (GClosure C_SorterChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SorterChangedCallback` into a `C_SorterChangedCallback`.
wrap_SorterChangedCallback ::
    SorterChangedCallback ->
    C_SorterChangedCallback
wrap_SorterChangedCallback :: SorterChangedCallback -> C_SorterChangedCallback
wrap_SorterChangedCallback SorterChangedCallback
_cb Ptr ()
_ CUInt
change Ptr ()
_ = do
    let change' :: SorterChange
change' = (Int -> SorterChange
forall a. Enum a => Int -> a
toEnum (Int -> SorterChange) -> (CUInt -> Int) -> CUInt -> SorterChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
change
    SorterChangedCallback
_cb  SorterChange
change'


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' sorter #changed callback
-- @
-- 
-- 
onSorterChanged :: (IsSorter a, MonadIO m) => a -> SorterChangedCallback -> m SignalHandlerId
onSorterChanged :: forall a (m :: * -> *).
(IsSorter a, MonadIO m) =>
a -> SorterChangedCallback -> m SignalHandlerId
onSorterChanged a
obj SorterChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_SorterChangedCallback
cb' = SorterChangedCallback -> C_SorterChangedCallback
wrap_SorterChangedCallback SorterChangedCallback
cb
    FunPtr C_SorterChangedCallback
cb'' <- C_SorterChangedCallback -> IO (FunPtr C_SorterChangedCallback)
mk_SorterChangedCallback C_SorterChangedCallback
cb'
    a
-> Text
-> FunPtr C_SorterChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_SorterChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' sorter #changed callback
-- @
-- 
-- 
afterSorterChanged :: (IsSorter a, MonadIO m) => a -> SorterChangedCallback -> m SignalHandlerId
afterSorterChanged :: forall a (m :: * -> *).
(IsSorter a, MonadIO m) =>
a -> SorterChangedCallback -> m SignalHandlerId
afterSorterChanged a
obj SorterChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_SorterChangedCallback
cb' = SorterChangedCallback -> C_SorterChangedCallback
wrap_SorterChangedCallback SorterChangedCallback
cb
    FunPtr C_SorterChangedCallback
cb'' <- C_SorterChangedCallback -> IO (FunPtr C_SorterChangedCallback)
mk_SorterChangedCallback C_SorterChangedCallback
cb'
    a
-> Text
-> FunPtr C_SorterChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_SorterChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SorterChangedSignalInfo
instance SignalInfo SorterChangedSignalInfo where
    type HaskellCallbackType SorterChangedSignalInfo = SorterChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SorterChangedCallback cb
        cb'' <- mk_SorterChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Sorter
type instance O.AttributeList Sorter = SorterAttributeList
type SorterAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Sorter = SorterSignalList
type SorterSignalList = ('[ '("changed", SorterChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_sorter_changed" gtk_sorter_changed :: 
    Ptr Sorter ->                           -- self : TInterface (Name {namespace = "Gtk", name = "Sorter"})
    CUInt ->                                -- change : TInterface (Name {namespace = "Gtk", name = "SorterChange"})
    IO ()

-- | Emits the [changed]("GI.Gtk.Objects.Sorter#g:signal:changed") signal to notify all users of the sorter
-- that it has changed. Users of the sorter should then update the sort
-- order via 'GI.Gtk.Objects.Sorter.sorterCompare'.
-- 
-- Depending on the /@change@/ parameter, it may be possible to update
-- the sort order without a full resorting. Refer to the t'GI.Gtk.Enums.SorterChange'
-- documentation for details.
-- 
-- This function is intended for implementors of t'GI.Gtk.Objects.Sorter.Sorter' subclasses and
-- should not be called from other functions.
sorterChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsSorter a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Sorter.Sorter'
    -> Gtk.Enums.SorterChange
    -- ^ /@change@/: How the sorter changed
    -> m ()
sorterChanged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSorter a) =>
a -> SorterChange -> m ()
sorterChanged a
self SorterChange
change = 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 Sorter
self' <- a -> IO (Ptr Sorter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let change' :: CUInt
change' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SorterChange -> Int) -> SorterChange -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SorterChange -> Int
forall a. Enum a => a -> Int
fromEnum) SorterChange
change
    Ptr Sorter -> CUInt -> IO ()
gtk_sorter_changed Ptr Sorter
self' CUInt
change'
    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 SorterChangedMethodInfo
instance (signature ~ (Gtk.Enums.SorterChange -> m ()), MonadIO m, IsSorter a) => O.OverloadedMethod SorterChangedMethodInfo a signature where
    overloadedMethod = sorterChanged

instance O.OverloadedMethodInfo SorterChangedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Sorter.sorterChanged",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Sorter.html#v:sorterChanged"
        }


#endif

-- method Sorter::compare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Sorter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSorter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item1"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first item to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item2"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second item to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Ordering" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_sorter_compare" gtk_sorter_compare :: 
    Ptr Sorter ->                           -- self : TInterface (Name {namespace = "Gtk", name = "Sorter"})
    Ptr GObject.Object.Object ->            -- item1 : TInterface (Name {namespace = "GObject", name = "Object"})
    Ptr GObject.Object.Object ->            -- item2 : TInterface (Name {namespace = "GObject", name = "Object"})
    IO CInt

-- | Compares two given items according to the sort order implemented
-- by the sorter.
-- 
-- Sorters implement a partial order:
-- * It is reflexive, ie a = a
-- * It is antisymmetric, ie if a \< b and b \< a, then a = b
-- * It is transitive, ie given any 3 items with a ≤ b and b ≤ c,
--   then a ≤ c
-- 
-- The sorter  may signal it conforms to additional constraints
-- via the return value of 'GI.Gtk.Objects.Sorter.sorterGetOrder'.
sorterCompare ::
    (B.CallStack.HasCallStack, MonadIO m, IsSorter a, GObject.Object.IsObject b, GObject.Object.IsObject c) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Sorter.Sorter'
    -> b
    -- ^ /@item1@/: first item to compare
    -> c
    -- ^ /@item2@/: second item to compare
    -> m Gtk.Enums.Ordering
    -- ^ __Returns:__ 'GI.Gtk.Enums.OrderingEqual' if /@item1@/ == /@item2@/,
    --     'GI.Gtk.Enums.OrderingSmaller' if /@item1@/ \< /@item2@/,
    --     'GI.Gtk.Enums.OrderingLarger' if /@item1@/ > /@item2@/
sorterCompare :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSorter a, IsObject b, IsObject c) =>
a -> b -> c -> m Ordering
sorterCompare a
self b
item1 c
item2 = IO Ordering -> m Ordering
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ordering -> m Ordering) -> IO Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sorter
self' <- a -> IO (Ptr Sorter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
item1' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item1
    Ptr Object
item2' <- c -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
item2
    CInt
result <- Ptr Sorter -> Ptr Object -> Ptr Object -> IO CInt
gtk_sorter_compare Ptr Sorter
self' Ptr Object
item1' Ptr Object
item2'
    let result' :: Ordering
result' = (Int -> Ordering
forall a. Enum a => Int -> a
toEnum (Int -> Ordering) -> (CInt -> Int) -> CInt -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item1
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
item2
    Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
result'

#if defined(ENABLE_OVERLOADING)
data SorterCompareMethodInfo
instance (signature ~ (b -> c -> m Gtk.Enums.Ordering), MonadIO m, IsSorter a, GObject.Object.IsObject b, GObject.Object.IsObject c) => O.OverloadedMethod SorterCompareMethodInfo a signature where
    overloadedMethod = sorterCompare

instance O.OverloadedMethodInfo SorterCompareMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Sorter.sorterCompare",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Sorter.html#v:sorterCompare"
        }


#endif

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

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

-- | Gets the order that /@self@/ conforms to. See t'GI.Gtk.Enums.SorterOrder' for details
-- of the possible return values.
-- 
-- This function is intended to allow optimizations.
sorterGetOrder ::
    (B.CallStack.HasCallStack, MonadIO m, IsSorter a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Sorter.Sorter'
    -> m Gtk.Enums.SorterOrder
    -- ^ __Returns:__ The order
sorterGetOrder :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSorter a) =>
a -> m SorterOrder
sorterGetOrder a
self = IO SorterOrder -> m SorterOrder
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SorterOrder -> m SorterOrder)
-> IO SorterOrder -> m SorterOrder
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sorter
self' <- a -> IO (Ptr Sorter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Sorter -> IO CUInt
gtk_sorter_get_order Ptr Sorter
self'
    let result' :: SorterOrder
result' = (Int -> SorterOrder
forall a. Enum a => Int -> a
toEnum (Int -> SorterOrder) -> (CUInt -> Int) -> CUInt -> SorterOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SorterOrder -> IO SorterOrder
forall (m :: * -> *) a. Monad m => a -> m a
return SorterOrder
result'

#if defined(ENABLE_OVERLOADING)
data SorterGetOrderMethodInfo
instance (signature ~ (m Gtk.Enums.SorterOrder), MonadIO m, IsSorter a) => O.OverloadedMethod SorterGetOrderMethodInfo a signature where
    overloadedMethod = sorterGetOrder

instance O.OverloadedMethodInfo SorterGetOrderMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Sorter.sorterGetOrder",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Sorter.html#v:sorterGetOrder"
        }


#endif