{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.ListStore.ListStore' is a simple implementation of t'GI.Gio.Interfaces.ListModel.ListModel' that stores all
-- items in memory.
-- 
-- It provides insertions, deletions, and lookups in logarithmic time
-- with a fast path for the common case of iterating the list linearly.

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

module GI.Gio.Objects.ListStore
    ( 

-- * Exported types
    ListStore(..)                           ,
    IsListStore                             ,
    toListStore                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [append]("GI.Gio.Objects.ListStore#g:method:append"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [find]("GI.Gio.Objects.ListStore#g:method:find"), [findWithEqualFunc]("GI.Gio.Objects.ListStore#g:method:findWithEqualFunc"), [findWithEqualFuncFull]("GI.Gio.Objects.ListStore#g:method:findWithEqualFuncFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [insert]("GI.Gio.Objects.ListStore#g:method:insert"), [insertSorted]("GI.Gio.Objects.ListStore#g:method:insertSorted"), [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"), [remove]("GI.Gio.Objects.ListStore#g:method:remove"), [removeAll]("GI.Gio.Objects.ListStore#g:method:removeAll"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sort]("GI.Gio.Objects.ListStore#g:method:sort"), [splice]("GI.Gio.Objects.ListStore#g:method:splice"), [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"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [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)
    ResolveListStoreMethod                  ,
#endif

-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    ListStoreAppendMethodInfo               ,
#endif
    listStoreAppend                         ,


-- ** find #method:find#

#if defined(ENABLE_OVERLOADING)
    ListStoreFindMethodInfo                 ,
#endif
    listStoreFind                           ,


-- ** findWithEqualFunc #method:findWithEqualFunc#

#if defined(ENABLE_OVERLOADING)
    ListStoreFindWithEqualFuncMethodInfo    ,
#endif
    listStoreFindWithEqualFunc              ,


-- ** findWithEqualFuncFull #method:findWithEqualFuncFull#

#if defined(ENABLE_OVERLOADING)
    ListStoreFindWithEqualFuncFullMethodInfo,
#endif
    listStoreFindWithEqualFuncFull          ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    ListStoreInsertMethodInfo               ,
#endif
    listStoreInsert                         ,


-- ** insertSorted #method:insertSorted#

#if defined(ENABLE_OVERLOADING)
    ListStoreInsertSortedMethodInfo         ,
#endif
    listStoreInsertSorted                   ,


-- ** new #method:new#

    listStoreNew                            ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ListStoreRemoveMethodInfo               ,
#endif
    listStoreRemove                         ,


-- ** removeAll #method:removeAll#

#if defined(ENABLE_OVERLOADING)
    ListStoreRemoveAllMethodInfo            ,
#endif
    listStoreRemoveAll                      ,


-- ** sort #method:sort#

#if defined(ENABLE_OVERLOADING)
    ListStoreSortMethodInfo                 ,
#endif
    listStoreSort                           ,


-- ** splice #method:splice#

#if defined(ENABLE_OVERLOADING)
    ListStoreSpliceMethodInfo               ,
#endif
    listStoreSplice                         ,




 -- * Properties


-- ** itemType #attr:itemType#
-- | The type of items contained in this list store. Items must be
-- subclasses of t'GI.GObject.Objects.Object.Object'.
-- 
-- /Since: 2.44/

#if defined(ENABLE_OVERLOADING)
    ListStoreItemTypePropertyInfo           ,
#endif
    constructListStoreItemType              ,
    getListStoreItemType                    ,
#if defined(ENABLE_OVERLOADING)
    listStoreItemType                       ,
#endif


-- ** nItems #attr:nItems#
-- | The number of items contained in this list store.
-- 
-- /Since: 2.74/

#if defined(ENABLE_OVERLOADING)
    ListStoreNItemsPropertyInfo             ,
#endif
    getListStoreNItems                      ,
#if defined(ENABLE_OVERLOADING)
    listStoreNItems                         ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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

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

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

foreign import ccall "g_list_store_get_type"
    c_g_list_store_get_type :: IO B.Types.GType

instance B.Types.TypedObject ListStore where
    glibType :: IO GType
glibType = IO GType
c_g_list_store_get_type

instance B.Types.GObject ListStore

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveListStoreMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveListStoreMethod "append" o = ListStoreAppendMethodInfo
    ResolveListStoreMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveListStoreMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveListStoreMethod "find" o = ListStoreFindMethodInfo
    ResolveListStoreMethod "findWithEqualFunc" o = ListStoreFindWithEqualFuncMethodInfo
    ResolveListStoreMethod "findWithEqualFuncFull" o = ListStoreFindWithEqualFuncFullMethodInfo
    ResolveListStoreMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveListStoreMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveListStoreMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveListStoreMethod "insert" o = ListStoreInsertMethodInfo
    ResolveListStoreMethod "insertSorted" o = ListStoreInsertSortedMethodInfo
    ResolveListStoreMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveListStoreMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveListStoreMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveListStoreMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveListStoreMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveListStoreMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveListStoreMethod "remove" o = ListStoreRemoveMethodInfo
    ResolveListStoreMethod "removeAll" o = ListStoreRemoveAllMethodInfo
    ResolveListStoreMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveListStoreMethod "sort" o = ListStoreSortMethodInfo
    ResolveListStoreMethod "splice" o = ListStoreSpliceMethodInfo
    ResolveListStoreMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveListStoreMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveListStoreMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveListStoreMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveListStoreMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveListStoreMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveListStoreMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveListStoreMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveListStoreMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveListStoreMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveListStoreMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveListStoreMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveListStoreMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveListStoreMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveListStoreMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@item-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' listStore #itemType
-- @
getListStoreItemType :: (MonadIO m, IsListStore o) => o -> m GType
getListStoreItemType :: forall (m :: * -> *) o. (MonadIO m, IsListStore o) => o -> m GType
getListStoreItemType 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"

-- | Construct a `GValueConstruct` with valid value for the “@item-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructListStoreItemType :: (IsListStore o, MIO.MonadIO m) => GType -> m (GValueConstruct o)
constructListStoreItemType :: forall o (m :: * -> *).
(IsListStore o, MonadIO m) =>
GType -> m (GValueConstruct o)
constructListStoreItemType GType
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 -> GType -> IO (GValueConstruct o)
forall o. String -> GType -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGType String
"item-type" GType
val

#if defined(ENABLE_OVERLOADING)
data ListStoreItemTypePropertyInfo
instance AttrInfo ListStoreItemTypePropertyInfo where
    type AttrAllowedOps ListStoreItemTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ListStoreItemTypePropertyInfo = IsListStore
    type AttrSetTypeConstraint ListStoreItemTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint ListStoreItemTypePropertyInfo = (~) GType
    type AttrTransferType ListStoreItemTypePropertyInfo = GType
    type AttrGetType ListStoreItemTypePropertyInfo = GType
    type AttrLabel ListStoreItemTypePropertyInfo = "item-type"
    type AttrOrigin ListStoreItemTypePropertyInfo = ListStore
    attrGet = getListStoreItemType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructListStoreItemType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.itemType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#g:attr:itemType"
        })
#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' listStore #nItems
-- @
getListStoreNItems :: (MonadIO m, IsListStore o) => o -> m Word32
getListStoreNItems :: forall (m :: * -> *) o. (MonadIO m, IsListStore o) => o -> m Word32
getListStoreNItems 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 ListStoreNItemsPropertyInfo
instance AttrInfo ListStoreNItemsPropertyInfo where
    type AttrAllowedOps ListStoreNItemsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ListStoreNItemsPropertyInfo = IsListStore
    type AttrSetTypeConstraint ListStoreNItemsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ListStoreNItemsPropertyInfo = (~) ()
    type AttrTransferType ListStoreNItemsPropertyInfo = ()
    type AttrGetType ListStoreNItemsPropertyInfo = Word32
    type AttrLabel ListStoreNItemsPropertyInfo = "n-items"
    type AttrOrigin ListStoreNItemsPropertyInfo = ListStore
    attrGet = getListStoreNItems
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.nItems"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#g:attr:nItems"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ListStore
type instance O.AttributeList ListStore = ListStoreAttributeList
type ListStoreAttributeList = ('[ '("itemType", ListStoreItemTypePropertyInfo), '("nItems", ListStoreNItemsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

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

listStoreNItems :: AttrLabelProxy "nItems"
listStoreNItems = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ListStore = ListStoreSignalList
type ListStoreSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ListStore::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "item_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of items in the list"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListStore" })
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_new" g_list_store_new :: 
    CGType ->                               -- item_type : TBasicType TGType
    IO (Ptr ListStore)

-- | Creates a new t'GI.Gio.Objects.ListStore.ListStore' with items of type /@itemType@/. /@itemType@/
-- must be a subclass of t'GI.GObject.Objects.Object.Object'.
-- 
-- /Since: 2.44/
listStoreNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@itemType@/: the t'GType' of items in the list
    -> m ListStore
    -- ^ __Returns:__ a new t'GI.Gio.Objects.ListStore.ListStore'
listStoreNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> m ListStore
listStoreNew GType
itemType = IO ListStore -> m ListStore
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListStore -> m ListStore) -> IO ListStore -> m ListStore
forall a b. (a -> b) -> a -> b
$ do
    let itemType' :: CGType
itemType' = GType -> CGType
gtypeToCGType GType
itemType
    Ptr ListStore
result <- CGType -> IO (Ptr ListStore)
g_list_store_new CGType
itemType'
    Text -> Ptr ListStore -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"listStoreNew" Ptr ListStore
result
    ListStore
result' <- ((ManagedPtr ListStore -> ListStore)
-> Ptr ListStore -> IO ListStore
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListStore -> ListStore
ListStore) Ptr ListStore
result
    ListStore -> IO ListStore
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListStore
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ListStore::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_append" g_list_store_append :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Ptr GObject.Object.Object ->            -- item : TInterface (Name {namespace = "GObject", name = "Object"})
    IO ()

-- | Appends /@item@/ to /@store@/. /@item@/ must be of type [ListStore:itemType]("GI.Gio.Objects.ListStore#g:attr:itemType").
-- 
-- This function takes a ref on /@item@/.
-- 
-- Use 'GI.Gio.Objects.ListStore.listStoreSplice' to append multiple items at the same time
-- efficiently.
-- 
-- /Since: 2.44/
listStoreAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a, GObject.Object.IsObject b) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> b
    -- ^ /@item@/: the new item
    -> m ()
listStoreAppend :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListStore a, IsObject b) =>
a -> b -> m ()
listStoreAppend a
store b
item = 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 ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Object
item' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ListStore -> Ptr Object -> IO ()
g_list_store_append Ptr ListStore
store' Ptr Object
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListStoreAppendMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsListStore a, GObject.Object.IsObject b) => O.OverloadedMethod ListStoreAppendMethodInfo a signature where
    overloadedMethod = listStoreAppend

instance O.OverloadedMethodInfo ListStoreAppendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreAppend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreAppend"
        })


#endif

-- method ListStore::find
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first position of @item, if it was found."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_find" g_list_store_find :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Ptr GObject.Object.Object ->            -- item : TInterface (Name {namespace = "GObject", name = "Object"})
    Ptr Word32 ->                           -- position : TBasicType TUInt
    IO CInt

-- | Looks up the given /@item@/ in the list store by looping over the items until
-- the first occurrence of /@item@/. If /@item@/ was not found, then /@position@/ will
-- not be set, and this method will return 'P.False'.
-- 
-- If you need to compare the two items with a custom comparison function, use
-- 'GI.Gio.Objects.ListStore.listStoreFindWithEqualFunc' with a custom t'GI.GLib.Callbacks.EqualFunc' instead.
-- 
-- /Since: 2.64/
listStoreFind ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a, GObject.Object.IsObject b) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> b
    -- ^ /@item@/: an item
    -> m ((Bool, Word32))
    -- ^ __Returns:__ Whether /@store@/ contains /@item@/. If it was found, /@position@/ will be
    -- set to the position where /@item@/ occurred for the first time.
listStoreFind :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListStore a, IsObject b) =>
a -> b -> m (Bool, Word32)
listStoreFind a
store b
item = IO (Bool, Word32) -> m (Bool, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Object
item' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr Word32
position <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr ListStore -> Ptr Object -> Ptr Word32 -> IO CInt
g_list_store_find Ptr ListStore
store' Ptr Object
item' Ptr Word32
position
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
position' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
position
    (Bool, Word32) -> IO (Bool, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
position')

#if defined(ENABLE_OVERLOADING)
data ListStoreFindMethodInfo
instance (signature ~ (b -> m ((Bool, Word32))), MonadIO m, IsListStore a, GObject.Object.IsObject b) => O.OverloadedMethod ListStoreFindMethodInfo a signature where
    overloadedMethod = listStoreFind

instance O.OverloadedMethodInfo ListStoreFindMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreFind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreFind"
        })


#endif

-- method ListStore::find_with_equal_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "equal_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "EqualFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A custom equality check function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first position of @item, if it was found."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_find_with_equal_func" g_list_store_find_with_equal_func :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Ptr GObject.Object.Object ->            -- item : TInterface (Name {namespace = "GObject", name = "Object"})
    FunPtr GLib.Callbacks.C_EqualFunc ->    -- equal_func : TInterface (Name {namespace = "GLib", name = "EqualFunc"})
    Ptr Word32 ->                           -- position : TBasicType TUInt
    IO CInt

-- | Looks up the given /@item@/ in the list store by looping over the items and
-- comparing them with /@equalFunc@/ until the first occurrence of /@item@/ which
-- matches. If /@item@/ was not found, then /@position@/ will not be set, and this
-- method will return 'P.False'.
-- 
-- /@item@/ is always passed as second parameter to /@equalFunc@/.
-- 
-- Since GLib 2.76 it is possible to pass @NULL@ for /@item@/.
-- 
-- /Since: 2.64/
listStoreFindWithEqualFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a, GObject.Object.IsObject b) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> Maybe (b)
    -- ^ /@item@/: an item
    -> GLib.Callbacks.EqualFunc
    -- ^ /@equalFunc@/: A custom equality check function
    -> m ((Bool, Word32))
    -- ^ __Returns:__ Whether /@store@/ contains /@item@/. If it was found, /@position@/ will be
    -- set to the position where /@item@/ occurred for the first time.
listStoreFindWithEqualFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListStore a, IsObject b) =>
a -> Maybe b -> EqualFunc -> m (Bool, Word32)
listStoreFindWithEqualFunc a
store Maybe b
item EqualFunc
equalFunc = IO (Bool, Word32) -> m (Bool, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Object
maybeItem <- case Maybe b
item of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jItem -> do
            Ptr Object
jItem' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jItem
            Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jItem'
    FunPtr C_EqualFunc
equalFunc' <- C_EqualFunc -> IO (FunPtr C_EqualFunc)
GLib.Callbacks.mk_EqualFunc (Maybe (Ptr (FunPtr C_EqualFunc)) -> EqualFunc -> C_EqualFunc
GLib.Callbacks.wrap_EqualFunc Maybe (Ptr (FunPtr C_EqualFunc))
forall a. Maybe a
Nothing EqualFunc
equalFunc)
    Ptr Word32
position <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr ListStore
-> Ptr Object -> FunPtr C_EqualFunc -> Ptr Word32 -> IO CInt
g_list_store_find_with_equal_func Ptr ListStore
store' Ptr Object
maybeItem FunPtr C_EqualFunc
equalFunc' Ptr Word32
position
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
position' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
position
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_EqualFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_EqualFunc
equalFunc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
item b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
position
    (Bool, Word32) -> IO (Bool, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
position')

#if defined(ENABLE_OVERLOADING)
data ListStoreFindWithEqualFuncMethodInfo
instance (signature ~ (Maybe (b) -> GLib.Callbacks.EqualFunc -> m ((Bool, Word32))), MonadIO m, IsListStore a, GObject.Object.IsObject b) => O.OverloadedMethod ListStoreFindWithEqualFuncMethodInfo a signature where
    overloadedMethod = listStoreFindWithEqualFunc

instance O.OverloadedMethodInfo ListStoreFindWithEqualFuncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreFindWithEqualFunc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreFindWithEqualFunc"
        })


#endif

-- method ListStore::find_with_equal_func_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "equal_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "EqualFuncFull" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A custom equality check function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @equal_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first position of @item, if it was found."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_find_with_equal_func_full" g_list_store_find_with_equal_func_full :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Ptr GObject.Object.Object ->            -- item : TInterface (Name {namespace = "GObject", name = "Object"})
    FunPtr GLib.Callbacks.C_EqualFuncFull -> -- equal_func : TInterface (Name {namespace = "GLib", name = "EqualFuncFull"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    Ptr Word32 ->                           -- position : TBasicType TUInt
    IO CInt

-- | Like 'GI.Gio.Objects.ListStore.listStoreFindWithEqualFunc' but with an additional /@userData@/
-- that is passed to /@equalFunc@/.
-- 
-- /@item@/ is always passed as second parameter to /@equalFunc@/.
-- 
-- Since GLib 2.76 it is possible to pass @NULL@ for /@item@/.
-- 
-- /Since: 2.74/
listStoreFindWithEqualFuncFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a, GObject.Object.IsObject b) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> Maybe (b)
    -- ^ /@item@/: an item
    -> GLib.Callbacks.EqualFuncFull
    -- ^ /@equalFunc@/: A custom equality check function
    -> m ((Bool, Word32))
    -- ^ __Returns:__ Whether /@store@/ contains /@item@/. If it was found, /@position@/ will be
    -- set to the position where /@item@/ occurred for the first time.
listStoreFindWithEqualFuncFull :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListStore a, IsObject b) =>
a -> Maybe b -> EqualFunc -> m (Bool, Word32)
listStoreFindWithEqualFuncFull a
store Maybe b
item EqualFunc
equalFunc = IO (Bool, Word32) -> m (Bool, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Object
maybeItem <- case Maybe b
item of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jItem -> do
            Ptr Object
jItem' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jItem
            Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jItem'
    FunPtr C_EqualFuncFull
equalFunc' <- C_EqualFuncFull -> IO (FunPtr C_EqualFuncFull)
GLib.Callbacks.mk_EqualFuncFull (Maybe (Ptr (FunPtr C_EqualFuncFull))
-> EqualFuncFull_WithClosures -> C_EqualFuncFull
GLib.Callbacks.wrap_EqualFuncFull Maybe (Ptr (FunPtr C_EqualFuncFull))
forall a. Maybe a
Nothing (EqualFunc -> EqualFuncFull_WithClosures
GLib.Callbacks.drop_closures_EqualFuncFull EqualFunc
equalFunc))
    Ptr Word32
position <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr ListStore
-> Ptr Object
-> FunPtr C_EqualFuncFull
-> Ptr ()
-> Ptr Word32
-> IO CInt
g_list_store_find_with_equal_func_full Ptr ListStore
store' Ptr Object
maybeItem FunPtr C_EqualFuncFull
equalFunc' Ptr ()
forall a. Ptr a
userData Ptr Word32
position
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
position' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
position
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_EqualFuncFull -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_EqualFuncFull
equalFunc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
item b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
position
    (Bool, Word32) -> IO (Bool, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
position')

#if defined(ENABLE_OVERLOADING)
data ListStoreFindWithEqualFuncFullMethodInfo
instance (signature ~ (Maybe (b) -> GLib.Callbacks.EqualFuncFull -> m ((Bool, Word32))), MonadIO m, IsListStore a, GObject.Object.IsObject b) => O.OverloadedMethod ListStoreFindWithEqualFuncFullMethodInfo a signature where
    overloadedMethod = listStoreFindWithEqualFuncFull

instance O.OverloadedMethodInfo ListStoreFindWithEqualFuncFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreFindWithEqualFuncFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreFindWithEqualFuncFull"
        })


#endif

-- method ListStore::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to insert the new item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_insert" g_list_store_insert :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Word32 ->                               -- position : TBasicType TUInt
    Ptr GObject.Object.Object ->            -- item : TInterface (Name {namespace = "GObject", name = "Object"})
    IO ()

-- | Inserts /@item@/ into /@store@/ at /@position@/. /@item@/ must be of type
-- [ListStore:itemType]("GI.Gio.Objects.ListStore#g:attr:itemType") or derived from it. /@position@/ must be smaller
-- than the length of the list, or equal to it to append.
-- 
-- This function takes a ref on /@item@/.
-- 
-- Use 'GI.Gio.Objects.ListStore.listStoreSplice' to insert multiple items at the same time
-- efficiently.
-- 
-- /Since: 2.44/
listStoreInsert ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a, GObject.Object.IsObject b) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> Word32
    -- ^ /@position@/: the position at which to insert the new item
    -> b
    -- ^ /@item@/: the new item
    -> m ()
listStoreInsert :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListStore a, IsObject b) =>
a -> Word32 -> b -> m ()
listStoreInsert a
store Word32
position b
item = 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 ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Object
item' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ListStore -> Word32 -> Ptr Object -> IO ()
g_list_store_insert Ptr ListStore
store' Word32
position Ptr Object
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListStoreInsertMethodInfo
instance (signature ~ (Word32 -> b -> m ()), MonadIO m, IsListStore a, GObject.Object.IsObject b) => O.OverloadedMethod ListStoreInsertMethodInfo a signature where
    overloadedMethod = listStoreInsert

instance O.OverloadedMethodInfo ListStoreInsertMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreInsert",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreInsert"
        })


#endif

-- method ListStore::insert_sorted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareDataFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pairwise comparison function for sorting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @compare_func"
--                 , 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 "g_list_store_insert_sorted" g_list_store_insert_sorted :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Ptr GObject.Object.Object ->            -- item : TInterface (Name {namespace = "GObject", name = "Object"})
    FunPtr GLib.Callbacks.C_CompareDataFunc -> -- compare_func : TInterface (Name {namespace = "GLib", name = "CompareDataFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO Word32

-- | Inserts /@item@/ into /@store@/ at a position to be determined by the
-- /@compareFunc@/.
-- 
-- The list must already be sorted before calling this function or the
-- result is undefined.  Usually you would approach this by only ever
-- inserting items by way of this function.
-- 
-- This function takes a ref on /@item@/.
-- 
-- /Since: 2.44/
listStoreInsertSorted ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a, GObject.Object.IsObject b) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> b
    -- ^ /@item@/: the new item
    -> GLib.Callbacks.CompareDataFunc
    -- ^ /@compareFunc@/: pairwise comparison function for sorting
    -> m Word32
    -- ^ __Returns:__ the position at which /@item@/ was inserted
listStoreInsertSorted :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsListStore a, IsObject b) =>
a -> b -> CompareDataFunc -> m Word32
listStoreInsertSorted a
store b
item CompareDataFunc
compareFunc = 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 ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr Object
item' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    FunPtr C_CompareDataFunc
compareFunc' <- C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
GLib.Callbacks.mk_CompareDataFunc (Maybe (Ptr (FunPtr C_CompareDataFunc))
-> C_CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.wrap_CompareDataFunc Maybe (Ptr (FunPtr C_CompareDataFunc))
forall a. Maybe a
Nothing (CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.drop_closures_CompareDataFunc CompareDataFunc
compareFunc))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Word32
result <- Ptr ListStore
-> Ptr Object -> FunPtr C_CompareDataFunc -> Ptr () -> IO Word32
g_list_store_insert_sorted Ptr ListStore
store' Ptr Object
item' FunPtr C_CompareDataFunc
compareFunc' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CompareDataFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CompareDataFunc
compareFunc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ListStoreInsertSortedMethodInfo
instance (signature ~ (b -> GLib.Callbacks.CompareDataFunc -> m Word32), MonadIO m, IsListStore a, GObject.Object.IsObject b) => O.OverloadedMethod ListStoreInsertSortedMethodInfo a signature where
    overloadedMethod = listStoreInsertSorted

instance O.OverloadedMethodInfo ListStoreInsertSortedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreInsertSorted",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreInsertSorted"
        })


#endif

-- method ListStore::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the position of the item that is to be removed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_remove" g_list_store_remove :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Word32 ->                               -- position : TBasicType TUInt
    IO ()

-- | Removes the item from /@store@/ that is at /@position@/. /@position@/ must be
-- smaller than the current length of the list.
-- 
-- Use 'GI.Gio.Objects.ListStore.listStoreSplice' to remove multiple items at the same time
-- efficiently.
-- 
-- /Since: 2.44/
listStoreRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> Word32
    -- ^ /@position@/: the position of the item that is to be removed
    -> m ()
listStoreRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListStore a) =>
a -> Word32 -> m ()
listStoreRemove a
store Word32
position = 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 ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr ListStore -> Word32 -> IO ()
g_list_store_remove Ptr ListStore
store' Word32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListStoreRemoveMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsListStore a) => O.OverloadedMethod ListStoreRemoveMethodInfo a signature where
    overloadedMethod = listStoreRemove

instance O.OverloadedMethodInfo ListStoreRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreRemove"
        })


#endif

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

foreign import ccall "g_list_store_remove_all" g_list_store_remove_all :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    IO ()

-- | Removes all items from /@store@/.
-- 
-- /Since: 2.44/
listStoreRemoveAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> m ()
listStoreRemoveAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListStore a) =>
a -> m ()
listStoreRemoveAll a
store = 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 ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    Ptr ListStore -> IO ()
g_list_store_remove_all Ptr ListStore
store'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListStoreRemoveAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsListStore a) => O.OverloadedMethod ListStoreRemoveAllMethodInfo a signature where
    overloadedMethod = listStoreRemoveAll

instance O.OverloadedMethodInfo ListStoreRemoveAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreRemoveAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreRemoveAll"
        })


#endif

-- method ListStore::sort
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareDataFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pairwise comparison function for sorting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @compare_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_sort" g_list_store_sort :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    FunPtr GLib.Callbacks.C_CompareDataFunc -> -- compare_func : TInterface (Name {namespace = "GLib", name = "CompareDataFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Sort the items in /@store@/ according to /@compareFunc@/.
-- 
-- /Since: 2.46/
listStoreSort ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> GLib.Callbacks.CompareDataFunc
    -- ^ /@compareFunc@/: pairwise comparison function for sorting
    -> m ()
listStoreSort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListStore a) =>
a -> CompareDataFunc -> m ()
listStoreSort a
store CompareDataFunc
compareFunc = 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 ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    FunPtr C_CompareDataFunc
compareFunc' <- C_CompareDataFunc -> IO (FunPtr C_CompareDataFunc)
GLib.Callbacks.mk_CompareDataFunc (Maybe (Ptr (FunPtr C_CompareDataFunc))
-> C_CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.wrap_CompareDataFunc Maybe (Ptr (FunPtr C_CompareDataFunc))
forall a. Maybe a
Nothing (CompareDataFunc -> C_CompareDataFunc
GLib.Callbacks.drop_closures_CompareDataFunc CompareDataFunc
compareFunc))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr ListStore -> FunPtr C_CompareDataFunc -> Ptr () -> IO ()
g_list_store_sort Ptr ListStore
store' FunPtr C_CompareDataFunc
compareFunc' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CompareDataFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CompareDataFunc
compareFunc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListStoreSortMethodInfo
instance (signature ~ (GLib.Callbacks.CompareDataFunc -> m ()), MonadIO m, IsListStore a) => O.OverloadedMethod ListStoreSortMethodInfo a signature where
    overloadedMethod = listStoreSort

instance O.OverloadedMethodInfo ListStoreSortMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreSort",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreSort"
        })


#endif

-- method ListStore::splice
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "store"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListStore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to make the change"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_removals"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of items to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "additions"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 4
--                 (TInterface Name { namespace = "GObject" , name = "Object" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the items to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_additions"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of items to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_additions"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of items to add"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_list_store_splice" g_list_store_splice :: 
    Ptr ListStore ->                        -- store : TInterface (Name {namespace = "Gio", name = "ListStore"})
    Word32 ->                               -- position : TBasicType TUInt
    Word32 ->                               -- n_removals : TBasicType TUInt
    Ptr (Ptr GObject.Object.Object) ->      -- additions : TCArray False (-1) 4 (TInterface (Name {namespace = "GObject", name = "Object"}))
    Word32 ->                               -- n_additions : TBasicType TUInt
    IO ()

-- | Changes /@store@/ by removing /@nRemovals@/ items and adding /@nAdditions@/
-- items to it. /@additions@/ must contain /@nAdditions@/ items of type
-- [ListStore:itemType]("GI.Gio.Objects.ListStore#g:attr:itemType").  'P.Nothing' is not permitted.
-- 
-- This function is more efficient than 'GI.Gio.Objects.ListStore.listStoreInsert' and
-- 'GI.Gio.Objects.ListStore.listStoreRemove', because it only emits
-- [ListModel::itemsChanged]("GI.Gio.Interfaces.ListModel#g:signal:itemsChanged") once for the change.
-- 
-- This function takes a ref on each item in /@additions@/.
-- 
-- The parameters /@position@/ and /@nRemovals@/ must be correct (ie:
-- /@position@/ + /@nRemovals@/ must be less than or equal to the length of
-- the list at the time this function is called).
-- 
-- /Since: 2.44/
listStoreSplice ::
    (B.CallStack.HasCallStack, MonadIO m, IsListStore a) =>
    a
    -- ^ /@store@/: a t'GI.Gio.Objects.ListStore.ListStore'
    -> Word32
    -- ^ /@position@/: the position at which to make the change
    -> Word32
    -- ^ /@nRemovals@/: the number of items to remove
    -> [GObject.Object.Object]
    -- ^ /@additions@/: the items to add
    -> m ()
listStoreSplice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListStore a) =>
a -> Word32 -> Word32 -> [Object] -> m ()
listStoreSplice a
store Word32
position Word32
nRemovals [Object]
additions = 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
    let nAdditions :: Word32
nAdditions = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Object] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Object]
additions
    Ptr ListStore
store' <- a -> IO (Ptr ListStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
store
    [Ptr Object]
additions' <- (Object -> IO (Ptr Object)) -> [Object] -> IO [Ptr Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Object -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Object]
additions
    Ptr (Ptr Object)
additions'' <- [Ptr Object] -> IO (Ptr (Ptr Object))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Object]
additions'
    Ptr ListStore
-> Word32 -> Word32 -> Ptr (Ptr Object) -> Word32 -> IO ()
g_list_store_splice Ptr ListStore
store' Word32
position Word32
nRemovals Ptr (Ptr Object)
additions'' Word32
nAdditions
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
store
    (Object -> IO ()) -> [Object] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Object]
additions
    Ptr (Ptr Object) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Object)
additions''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ListStoreSpliceMethodInfo
instance (signature ~ (Word32 -> Word32 -> [GObject.Object.Object] -> m ()), MonadIO m, IsListStore a) => O.OverloadedMethod ListStoreSpliceMethodInfo a signature where
    overloadedMethod = listStoreSplice

instance O.OverloadedMethodInfo ListStoreSpliceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.ListStore.listStoreSplice",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-ListStore.html#v:listStoreSplice"
        })


#endif