{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A tree-like data structure that can be used with the t'GI.Gtk.Objects.TreeView.TreeView'.
-- 
-- The @GtkTreeStore@ object is a list model for use with a @GtkTreeView@
-- widget. It implements the t'GI.Gtk.Interfaces.TreeModel.TreeModel' interface, and consequently,
-- can use all of the methods available there. It also implements the
-- t'GI.Gtk.Interfaces.TreeSortable.TreeSortable' interface so it can be sorted by the view.
-- Finally, it also implements the tree [drag]t'GI.Gtk.Interfaces.TreeDragSource.TreeDragSource'
-- and [drop]t'GI.Gtk.Interfaces.TreeDragDest.TreeDragDest' interfaces.
-- 
-- @GtkTreeStore@ is deprecated since GTK 4.10, and should not be used in newly
-- written code. You should use t'GI.Gtk.Objects.TreeListModel.TreeListModel' for a tree-like model
-- object.
-- 
-- == GtkTreeStore as GtkBuildable
-- 
-- The GtkTreeStore implementation of the @GtkBuildable@ interface allows
-- to specify the model columns with a @\<columns>@ element that may contain
-- multiple @\<column>@ elements, each specifying one model column. The “type”
-- attribute specifies the data type for the column.
-- 
-- An example of a UI Definition fragment for a tree store:
-- 
-- 
-- === /xml code/
-- ><object class="GtkTreeStore">
-- >  <columns>
-- >    <column type="gchararray"/>
-- >    <column type="gchararray"/>
-- >    <column type="gint"/>
-- >  </columns>
-- ></object>
-- 

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

module GI.Gtk.Objects.TreeStore
    ( 

-- * Exported types
    TreeStore(..)                           ,
    IsTreeStore                             ,
    toTreeStore                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [append]("GI.Gtk.Objects.TreeStore#g:method:append"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clear]("GI.Gtk.Objects.TreeStore#g:method:clear"), [dragDataDelete]("GI.Gtk.Interfaces.TreeDragSource#g:method:dragDataDelete"), [dragDataGet]("GI.Gtk.Interfaces.TreeDragSource#g:method:dragDataGet"), [dragDataReceived]("GI.Gtk.Interfaces.TreeDragDest#g:method:dragDataReceived"), [filterNew]("GI.Gtk.Interfaces.TreeModel#g:method:filterNew"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.Gtk.Interfaces.TreeModel#g:method:foreach"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasDefaultSortFunc]("GI.Gtk.Interfaces.TreeSortable#g:method:hasDefaultSortFunc"), [insert]("GI.Gtk.Objects.TreeStore#g:method:insert"), [insertAfter]("GI.Gtk.Objects.TreeStore#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.TreeStore#g:method:insertBefore"), [insertWithValues]("GI.Gtk.Objects.TreeStore#g:method:insertWithValues"), [isAncestor]("GI.Gtk.Objects.TreeStore#g:method:isAncestor"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [iterChildren]("GI.Gtk.Interfaces.TreeModel#g:method:iterChildren"), [iterDepth]("GI.Gtk.Objects.TreeStore#g:method:iterDepth"), [iterHasChild]("GI.Gtk.Interfaces.TreeModel#g:method:iterHasChild"), [iterIsValid]("GI.Gtk.Objects.TreeStore#g:method:iterIsValid"), [iterNChildren]("GI.Gtk.Interfaces.TreeModel#g:method:iterNChildren"), [iterNext]("GI.Gtk.Interfaces.TreeModel#g:method:iterNext"), [iterNthChild]("GI.Gtk.Interfaces.TreeModel#g:method:iterNthChild"), [iterParent]("GI.Gtk.Interfaces.TreeModel#g:method:iterParent"), [iterPrevious]("GI.Gtk.Interfaces.TreeModel#g:method:iterPrevious"), [moveAfter]("GI.Gtk.Objects.TreeStore#g:method:moveAfter"), [moveBefore]("GI.Gtk.Objects.TreeStore#g:method:moveBefore"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prepend]("GI.Gtk.Objects.TreeStore#g:method:prepend"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refNode]("GI.Gtk.Interfaces.TreeModel#g:method:refNode"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Gtk.Objects.TreeStore#g:method:remove"), [rowChanged]("GI.Gtk.Interfaces.TreeModel#g:method:rowChanged"), [rowDeleted]("GI.Gtk.Interfaces.TreeModel#g:method:rowDeleted"), [rowDraggable]("GI.Gtk.Interfaces.TreeDragSource#g:method:rowDraggable"), [rowDropPossible]("GI.Gtk.Interfaces.TreeDragDest#g:method:rowDropPossible"), [rowHasChildToggled]("GI.Gtk.Interfaces.TreeModel#g:method:rowHasChildToggled"), [rowInserted]("GI.Gtk.Interfaces.TreeModel#g:method:rowInserted"), [rowsReordered]("GI.Gtk.Interfaces.TreeModel#g:method:rowsReordered"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [set]("GI.Gtk.Objects.TreeStore#g:method:set"), [sortColumnChanged]("GI.Gtk.Interfaces.TreeSortable#g:method:sortColumnChanged"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [swap]("GI.Gtk.Objects.TreeStore#g:method:swap"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unrefNode]("GI.Gtk.Interfaces.TreeModel#g:method:unrefNode"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getColumnType]("GI.Gtk.Interfaces.TreeModel#g:method:getColumnType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Gtk.Interfaces.TreeModel#g:method:getFlags"), [getIter]("GI.Gtk.Interfaces.TreeModel#g:method:getIter"), [getIterFirst]("GI.Gtk.Interfaces.TreeModel#g:method:getIterFirst"), [getIterFromString]("GI.Gtk.Interfaces.TreeModel#g:method:getIterFromString"), [getNColumns]("GI.Gtk.Interfaces.TreeModel#g:method:getNColumns"), [getPath]("GI.Gtk.Interfaces.TreeModel#g:method:getPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSortColumnId]("GI.Gtk.Interfaces.TreeSortable#g:method:getSortColumnId"), [getStringFromIter]("GI.Gtk.Interfaces.TreeModel#g:method:getStringFromIter"), [getValue]("GI.Gtk.Interfaces.TreeModel#g:method:getValue").
-- 
-- ==== Setters
-- [setColumnTypes]("GI.Gtk.Objects.TreeStore#g:method:setColumnTypes"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultSortFunc]("GI.Gtk.Interfaces.TreeSortable#g:method:setDefaultSortFunc"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSortColumnId]("GI.Gtk.Interfaces.TreeSortable#g:method:setSortColumnId"), [setSortFunc]("GI.Gtk.Interfaces.TreeSortable#g:method:setSortFunc"), [setValue]("GI.Gtk.Objects.TreeStore#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveTreeStoreMethod                  ,
#endif

-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    TreeStoreAppendMethodInfo               ,
#endif
    treeStoreAppend                         ,


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    TreeStoreClearMethodInfo                ,
#endif
    treeStoreClear                          ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    TreeStoreInsertMethodInfo               ,
#endif
    treeStoreInsert                         ,


-- ** insertAfter #method:insertAfter#

#if defined(ENABLE_OVERLOADING)
    TreeStoreInsertAfterMethodInfo          ,
#endif
    treeStoreInsertAfter                    ,


-- ** insertBefore #method:insertBefore#

#if defined(ENABLE_OVERLOADING)
    TreeStoreInsertBeforeMethodInfo         ,
#endif
    treeStoreInsertBefore                   ,


-- ** insertWithValues #method:insertWithValues#

#if defined(ENABLE_OVERLOADING)
    TreeStoreInsertWithValuesMethodInfo     ,
#endif
    treeStoreInsertWithValues               ,


-- ** isAncestor #method:isAncestor#

#if defined(ENABLE_OVERLOADING)
    TreeStoreIsAncestorMethodInfo           ,
#endif
    treeStoreIsAncestor                     ,


-- ** iterDepth #method:iterDepth#

#if defined(ENABLE_OVERLOADING)
    TreeStoreIterDepthMethodInfo            ,
#endif
    treeStoreIterDepth                      ,


-- ** iterIsValid #method:iterIsValid#

#if defined(ENABLE_OVERLOADING)
    TreeStoreIterIsValidMethodInfo          ,
#endif
    treeStoreIterIsValid                    ,


-- ** moveAfter #method:moveAfter#

#if defined(ENABLE_OVERLOADING)
    TreeStoreMoveAfterMethodInfo            ,
#endif
    treeStoreMoveAfter                      ,


-- ** moveBefore #method:moveBefore#

#if defined(ENABLE_OVERLOADING)
    TreeStoreMoveBeforeMethodInfo           ,
#endif
    treeStoreMoveBefore                     ,


-- ** new #method:new#

    treeStoreNew                            ,


-- ** prepend #method:prepend#

#if defined(ENABLE_OVERLOADING)
    TreeStorePrependMethodInfo              ,
#endif
    treeStorePrepend                        ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    TreeStoreRemoveMethodInfo               ,
#endif
    treeStoreRemove                         ,


-- ** set #method:set#

#if defined(ENABLE_OVERLOADING)
    TreeStoreSetMethodInfo                  ,
#endif
    treeStoreSet                            ,


-- ** setColumnTypes #method:setColumnTypes#

#if defined(ENABLE_OVERLOADING)
    TreeStoreSetColumnTypesMethodInfo       ,
#endif
    treeStoreSetColumnTypes                 ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    TreeStoreSetValueMethodInfo             ,
#endif
    treeStoreSetValue                       ,


-- ** swap #method:swap#

#if defined(ENABLE_OVERLOADING)
    TreeStoreSwapMethodInfo                 ,
#endif
    treeStoreSwap                           ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeDragDest as Gtk.TreeDragDest
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeDragSource as Gtk.TreeDragSource
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeModel as Gtk.TreeModel
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeSortable as Gtk.TreeSortable
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreePath as Gtk.TreePath

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeDragDest as Gtk.TreeDragDest
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeDragSource as Gtk.TreeDragSource
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeModel as Gtk.TreeModel
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeSortable as Gtk.TreeSortable
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter

#endif

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

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

foreign import ccall "gtk_tree_store_get_type"
    c_gtk_tree_store_get_type :: IO B.Types.GType

instance B.Types.TypedObject TreeStore where
    glibType :: IO GType
glibType = IO GType
c_gtk_tree_store_get_type

instance B.Types.GObject TreeStore

-- | Type class for types which can be safely cast to t'TreeStore', for instance with `toTreeStore`.
class (SP.GObject o, O.IsDescendantOf TreeStore o) => IsTreeStore o
instance (SP.GObject o, O.IsDescendantOf TreeStore o) => IsTreeStore o

instance O.HasParentTypes TreeStore
type instance O.ParentTypes TreeStore = '[GObject.Object.Object, Gtk.Buildable.Buildable, Gtk.TreeDragDest.TreeDragDest, Gtk.TreeDragSource.TreeDragSource, Gtk.TreeModel.TreeModel, Gtk.TreeSortable.TreeSortable]

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

-- | Convert t'TreeStore' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe TreeStore) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_tree_store_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TreeStore -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TreeStore
P.Nothing = Ptr GValue -> Ptr TreeStore -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr TreeStore
forall a. Ptr a
FP.nullPtr :: FP.Ptr TreeStore)
    gvalueSet_ Ptr GValue
gv (P.Just TreeStore
obj) = TreeStore -> (Ptr TreeStore -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TreeStore
obj (Ptr GValue -> Ptr TreeStore -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TreeStore)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr TreeStore)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr TreeStore)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject TreeStore ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTreeStoreMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTreeStoreMethod "append" o = TreeStoreAppendMethodInfo
    ResolveTreeStoreMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTreeStoreMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTreeStoreMethod "clear" o = TreeStoreClearMethodInfo
    ResolveTreeStoreMethod "dragDataDelete" o = Gtk.TreeDragSource.TreeDragSourceDragDataDeleteMethodInfo
    ResolveTreeStoreMethod "dragDataGet" o = Gtk.TreeDragSource.TreeDragSourceDragDataGetMethodInfo
    ResolveTreeStoreMethod "dragDataReceived" o = Gtk.TreeDragDest.TreeDragDestDragDataReceivedMethodInfo
    ResolveTreeStoreMethod "filterNew" o = Gtk.TreeModel.TreeModelFilterNewMethodInfo
    ResolveTreeStoreMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTreeStoreMethod "foreach" o = Gtk.TreeModel.TreeModelForeachMethodInfo
    ResolveTreeStoreMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTreeStoreMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTreeStoreMethod "hasDefaultSortFunc" o = Gtk.TreeSortable.TreeSortableHasDefaultSortFuncMethodInfo
    ResolveTreeStoreMethod "insert" o = TreeStoreInsertMethodInfo
    ResolveTreeStoreMethod "insertAfter" o = TreeStoreInsertAfterMethodInfo
    ResolveTreeStoreMethod "insertBefore" o = TreeStoreInsertBeforeMethodInfo
    ResolveTreeStoreMethod "insertWithValues" o = TreeStoreInsertWithValuesMethodInfo
    ResolveTreeStoreMethod "isAncestor" o = TreeStoreIsAncestorMethodInfo
    ResolveTreeStoreMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTreeStoreMethod "iterChildren" o = Gtk.TreeModel.TreeModelIterChildrenMethodInfo
    ResolveTreeStoreMethod "iterDepth" o = TreeStoreIterDepthMethodInfo
    ResolveTreeStoreMethod "iterHasChild" o = Gtk.TreeModel.TreeModelIterHasChildMethodInfo
    ResolveTreeStoreMethod "iterIsValid" o = TreeStoreIterIsValidMethodInfo
    ResolveTreeStoreMethod "iterNChildren" o = Gtk.TreeModel.TreeModelIterNChildrenMethodInfo
    ResolveTreeStoreMethod "iterNext" o = Gtk.TreeModel.TreeModelIterNextMethodInfo
    ResolveTreeStoreMethod "iterNthChild" o = Gtk.TreeModel.TreeModelIterNthChildMethodInfo
    ResolveTreeStoreMethod "iterParent" o = Gtk.TreeModel.TreeModelIterParentMethodInfo
    ResolveTreeStoreMethod "iterPrevious" o = Gtk.TreeModel.TreeModelIterPreviousMethodInfo
    ResolveTreeStoreMethod "moveAfter" o = TreeStoreMoveAfterMethodInfo
    ResolveTreeStoreMethod "moveBefore" o = TreeStoreMoveBeforeMethodInfo
    ResolveTreeStoreMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTreeStoreMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTreeStoreMethod "prepend" o = TreeStorePrependMethodInfo
    ResolveTreeStoreMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTreeStoreMethod "refNode" o = Gtk.TreeModel.TreeModelRefNodeMethodInfo
    ResolveTreeStoreMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTreeStoreMethod "remove" o = TreeStoreRemoveMethodInfo
    ResolveTreeStoreMethod "rowChanged" o = Gtk.TreeModel.TreeModelRowChangedMethodInfo
    ResolveTreeStoreMethod "rowDeleted" o = Gtk.TreeModel.TreeModelRowDeletedMethodInfo
    ResolveTreeStoreMethod "rowDraggable" o = Gtk.TreeDragSource.TreeDragSourceRowDraggableMethodInfo
    ResolveTreeStoreMethod "rowDropPossible" o = Gtk.TreeDragDest.TreeDragDestRowDropPossibleMethodInfo
    ResolveTreeStoreMethod "rowHasChildToggled" o = Gtk.TreeModel.TreeModelRowHasChildToggledMethodInfo
    ResolveTreeStoreMethod "rowInserted" o = Gtk.TreeModel.TreeModelRowInsertedMethodInfo
    ResolveTreeStoreMethod "rowsReordered" o = Gtk.TreeModel.TreeModelRowsReorderedMethodInfo
    ResolveTreeStoreMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTreeStoreMethod "set" o = TreeStoreSetMethodInfo
    ResolveTreeStoreMethod "sortColumnChanged" o = Gtk.TreeSortable.TreeSortableSortColumnChangedMethodInfo
    ResolveTreeStoreMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTreeStoreMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTreeStoreMethod "swap" o = TreeStoreSwapMethodInfo
    ResolveTreeStoreMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTreeStoreMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTreeStoreMethod "unrefNode" o = Gtk.TreeModel.TreeModelUnrefNodeMethodInfo
    ResolveTreeStoreMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTreeStoreMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveTreeStoreMethod "getColumnType" o = Gtk.TreeModel.TreeModelGetColumnTypeMethodInfo
    ResolveTreeStoreMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTreeStoreMethod "getFlags" o = Gtk.TreeModel.TreeModelGetFlagsMethodInfo
    ResolveTreeStoreMethod "getIter" o = Gtk.TreeModel.TreeModelGetIterMethodInfo
    ResolveTreeStoreMethod "getIterFirst" o = Gtk.TreeModel.TreeModelGetIterFirstMethodInfo
    ResolveTreeStoreMethod "getIterFromString" o = Gtk.TreeModel.TreeModelGetIterFromStringMethodInfo
    ResolveTreeStoreMethod "getNColumns" o = Gtk.TreeModel.TreeModelGetNColumnsMethodInfo
    ResolveTreeStoreMethod "getPath" o = Gtk.TreeModel.TreeModelGetPathMethodInfo
    ResolveTreeStoreMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTreeStoreMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTreeStoreMethod "getSortColumnId" o = Gtk.TreeSortable.TreeSortableGetSortColumnIdMethodInfo
    ResolveTreeStoreMethod "getStringFromIter" o = Gtk.TreeModel.TreeModelGetStringFromIterMethodInfo
    ResolveTreeStoreMethod "getValue" o = Gtk.TreeModel.TreeModelGetValueMethodInfo
    ResolveTreeStoreMethod "setColumnTypes" o = TreeStoreSetColumnTypesMethodInfo
    ResolveTreeStoreMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTreeStoreMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTreeStoreMethod "setDefaultSortFunc" o = Gtk.TreeSortable.TreeSortableSetDefaultSortFuncMethodInfo
    ResolveTreeStoreMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTreeStoreMethod "setSortColumnId" o = Gtk.TreeSortable.TreeSortableSetSortColumnIdMethodInfo
    ResolveTreeStoreMethod "setSortFunc" o = Gtk.TreeSortable.TreeSortableSetSortFuncMethodInfo
    ResolveTreeStoreMethod "setValue" o = TreeStoreSetValueMethodInfo
    ResolveTreeStoreMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TreeStore
type instance O.AttributeList TreeStore = TreeStoreAttributeList
type TreeStoreAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TreeStore = TreeStoreSignalList
type TreeStoreSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("rowChanged", Gtk.TreeModel.TreeModelRowChangedSignalInfo), '("rowDeleted", Gtk.TreeModel.TreeModelRowDeletedSignalInfo), '("rowHasChildToggled", Gtk.TreeModel.TreeModelRowHasChildToggledSignalInfo), '("rowInserted", Gtk.TreeModel.TreeModelRowInsertedSignalInfo), '("sortColumnChanged", Gtk.TreeSortable.TreeSortableSortColumnChangedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method TreeStore::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of columns in the tree store"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType = TCArray False (-1) 0 (TBasicType TGType)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an array of `GType` types for the columns, from first to last"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of columns in the tree store"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "TreeStore" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_newv" gtk_tree_store_newv :: 
    Int32 ->                                -- n_columns : TBasicType TInt
    Ptr CGType ->                           -- types : TCArray False (-1) 0 (TBasicType TGType)
    IO (Ptr TreeStore)

{-# DEPRECATED treeStoreNew ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Creates a new tree store.
-- 
-- This constructor is meant for language bindings.
treeStoreNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [GType]
    -- ^ /@types@/: an array of @GType@ types for the columns, from first to last
    -> m TreeStore
    -- ^ __Returns:__ a new @GtkTreeStore@
treeStoreNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[GType] -> m TreeStore
treeStoreNew [GType]
types = IO TreeStore -> m TreeStore
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeStore -> m TreeStore) -> IO TreeStore -> m TreeStore
forall a b. (a -> b) -> a -> b
$ do
    let nColumns :: Int32
nColumns = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GType]
types
    types' <- ((GType -> CGType) -> [GType] -> IO (Ptr CGType)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray GType -> CGType
gtypeToCGType) [GType]
types
    result <- gtk_tree_store_newv nColumns types'
    checkUnexpectedReturnNULL "treeStoreNew" result
    result' <- (wrapObject TreeStore) result
    freeMem types'
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TreeStore::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "An unset `GtkTreeIter` to set to the appended row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_append" gtk_tree_store_append :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- parent : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStoreAppend ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Appends a new row to /@treeStore@/.
-- 
-- If /@parent@/ is non-'P.Nothing', then it will append the new row after the last
-- child of /@parent@/, otherwise it will append a row to the top level.
-- 
-- The /@iter@/ parameter will be changed to point to this new row. The row will
-- be empty after this function is called. To fill in values, you need to call
-- @/gtk_tree_store_set()/@ or 'GI.Gtk.Objects.TreeStore.treeStoreSetValue'.
treeStoreAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@parent@/: A valid @GtkTreeIter@
    -> m (Gtk.TreeIter.TreeIter)
treeStoreAppend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> Maybe TreeIter -> m TreeIter
treeStoreAppend a
treeStore Maybe TreeIter
parent = IO TreeIter -> m TreeIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeIter -> m TreeIter) -> IO TreeIter -> m TreeIter
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
    maybeParent <- case parent of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jParent -> do
            jParent' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jParent
            return jParent'
    gtk_tree_store_append treeStore' iter maybeParent
    iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
    touchManagedPtr treeStore
    whenJust parent touchManagedPtr
    return iter'

#if defined(ENABLE_OVERLOADING)
data TreeStoreAppendMethodInfo
instance (signature ~ (Maybe (Gtk.TreeIter.TreeIter) -> m (Gtk.TreeIter.TreeIter)), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreAppendMethodInfo a signature where
    overloadedMethod = treeStoreAppend

instance O.OverloadedMethodInfo TreeStoreAppendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreAppend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreAppend"
        })


#endif

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

foreign import ccall "gtk_tree_store_clear" gtk_tree_store_clear :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    IO ()

{-# DEPRECATED treeStoreClear ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Removes all rows from /@treeStore@/
treeStoreClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: a @GtkTreeStore@
    -> m ()
treeStoreClear :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> m ()
treeStoreClear a
treeStore = 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
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    gtk_tree_store_clear treeStore'
    touchManagedPtr treeStore
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreClearMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreClearMethodInfo a signature where
    overloadedMethod = treeStoreClear

instance O.OverloadedMethodInfo TreeStoreClearMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreClear",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreClear"
        })


#endif

-- method TreeStore::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An unset `GtkTreeIter` to set to the new row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "position to insert the new row, or -1 for last"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_insert" gtk_tree_store_insert :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- parent : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

{-# DEPRECATED treeStoreInsert ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Creates a new row at /@position@/.
-- 
-- If parent is non-'P.Nothing', then the row will be made a child of /@parent@/.
-- Otherwise, the row will be created at the toplevel.
-- 
-- If /@position@/ is @-1@ or is larger than the number of rows at that level,
-- then the new row will be inserted to the end of the list.
-- 
-- The /@iter@/ parameter will be changed to point to this new row. The row
-- will be empty after this function is called. To fill in values, you
-- need to call @/gtk_tree_store_set()/@ or 'GI.Gtk.Objects.TreeStore.treeStoreSetValue'.
treeStoreInsert ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@parent@/: A valid @GtkTreeIter@
    -> Int32
    -- ^ /@position@/: position to insert the new row, or -1 for last
    -> m (Gtk.TreeIter.TreeIter)
treeStoreInsert :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> Maybe TreeIter -> Int32 -> m TreeIter
treeStoreInsert a
treeStore Maybe TreeIter
parent Int32
position = IO TreeIter -> m TreeIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeIter -> m TreeIter) -> IO TreeIter -> m TreeIter
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
    maybeParent <- case parent of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jParent -> do
            jParent' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jParent
            return jParent'
    gtk_tree_store_insert treeStore' iter maybeParent position
    iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
    touchManagedPtr treeStore
    whenJust parent touchManagedPtr
    return iter'

#if defined(ENABLE_OVERLOADING)
data TreeStoreInsertMethodInfo
instance (signature ~ (Maybe (Gtk.TreeIter.TreeIter) -> Int32 -> m (Gtk.TreeIter.TreeIter)), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreInsertMethodInfo a signature where
    overloadedMethod = treeStoreInsert

instance O.OverloadedMethodInfo TreeStoreInsertMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreInsert",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreInsert"
        })


#endif

-- method TreeStore::insert_after
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An unset `GtkTreeIter` to set to the new row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sibling"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_insert_after" gtk_tree_store_insert_after :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- parent : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- sibling : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStoreInsertAfter ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Inserts a new row after /@sibling@/.
-- 
-- If /@sibling@/ is 'P.Nothing', then the row will be prepended to /@parent@/’s children.
-- 
-- If /@parent@/ and /@sibling@/ are 'P.Nothing', then the row will be prepended to the
-- toplevel.
-- 
-- If both /@sibling@/ and /@parent@/ are set, then /@parent@/ must be the parent
-- of /@sibling@/. When /@sibling@/ is set, /@parent@/ is optional.
-- 
-- The /@iter@/ parameter will be changed to point to this new row. The row will
-- be empty after this function is called. To fill in values, you need to call
-- @/gtk_tree_store_set()/@ or 'GI.Gtk.Objects.TreeStore.treeStoreSetValue'.
treeStoreInsertAfter ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@parent@/: A valid @GtkTreeIter@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@sibling@/: A valid @GtkTreeIter@
    -> m (Gtk.TreeIter.TreeIter)
treeStoreInsertAfter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> Maybe TreeIter -> Maybe TreeIter -> m TreeIter
treeStoreInsertAfter a
treeStore Maybe TreeIter
parent Maybe TreeIter
sibling = IO TreeIter -> m TreeIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeIter -> m TreeIter) -> IO TreeIter -> m TreeIter
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
    maybeParent <- case parent of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jParent -> do
            jParent' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jParent
            return jParent'
    maybeSibling <- case sibling of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jSibling -> do
            jSibling' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jSibling
            return jSibling'
    gtk_tree_store_insert_after treeStore' iter maybeParent maybeSibling
    iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
    touchManagedPtr treeStore
    whenJust parent touchManagedPtr
    whenJust sibling touchManagedPtr
    return iter'

#if defined(ENABLE_OVERLOADING)
data TreeStoreInsertAfterMethodInfo
instance (signature ~ (Maybe (Gtk.TreeIter.TreeIter) -> Maybe (Gtk.TreeIter.TreeIter) -> m (Gtk.TreeIter.TreeIter)), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreInsertAfterMethodInfo a signature where
    overloadedMethod = treeStoreInsertAfter

instance O.OverloadedMethodInfo TreeStoreInsertAfterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreInsertAfter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreInsertAfter"
        })


#endif

-- method TreeStore::insert_before
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An unset `GtkTreeIter` to set to the new row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sibling"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_insert_before" gtk_tree_store_insert_before :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- parent : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- sibling : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStoreInsertBefore ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Inserts a new row before /@sibling@/.
-- 
-- If /@sibling@/ is 'P.Nothing', then the row will be appended to /@parent@/’s children.
-- 
-- If /@parent@/ and /@sibling@/ are 'P.Nothing', then the row will be appended to the
-- toplevel.
-- 
-- If both /@sibling@/ and /@parent@/ are set, then /@parent@/ must be the parent
-- of /@sibling@/. When /@sibling@/ is set, /@parent@/ is optional.
-- 
-- The /@iter@/ parameter will be changed to point to this new row. The row will
-- be empty after this function is called. To fill in values, you need to call
-- @/gtk_tree_store_set()/@ or 'GI.Gtk.Objects.TreeStore.treeStoreSetValue'.
treeStoreInsertBefore ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@parent@/: A valid @GtkTreeIter@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@sibling@/: A valid @GtkTreeIter@
    -> m (Gtk.TreeIter.TreeIter)
treeStoreInsertBefore :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> Maybe TreeIter -> Maybe TreeIter -> m TreeIter
treeStoreInsertBefore a
treeStore Maybe TreeIter
parent Maybe TreeIter
sibling = IO TreeIter -> m TreeIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeIter -> m TreeIter) -> IO TreeIter -> m TreeIter
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
    maybeParent <- case parent of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jParent -> do
            jParent' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jParent
            return jParent'
    maybeSibling <- case sibling of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jSibling -> do
            jSibling' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jSibling
            return jSibling'
    gtk_tree_store_insert_before treeStore' iter maybeParent maybeSibling
    iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
    touchManagedPtr treeStore
    whenJust parent touchManagedPtr
    whenJust sibling touchManagedPtr
    return iter'

#if defined(ENABLE_OVERLOADING)
data TreeStoreInsertBeforeMethodInfo
instance (signature ~ (Maybe (Gtk.TreeIter.TreeIter) -> Maybe (Gtk.TreeIter.TreeIter) -> m (Gtk.TreeIter.TreeIter)), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreInsertBeforeMethodInfo a signature where
    overloadedMethod = treeStoreInsertBefore

instance O.OverloadedMethodInfo TreeStoreInsertBeforeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreInsertBefore",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreInsertBefore"
        })


#endif

-- method TreeStore::insert_with_values
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An unset `GtkTreeIter` to set the new row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "position to insert the new row, or -1 for last"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TCArray False (-1) 6 (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of column numbers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 6 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of GValues"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_values"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the @columns and @values arrays"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_values"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the @columns and @values arrays"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_values"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the @columns and @values arrays"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_insert_with_valuesv" gtk_tree_store_insert_with_valuesv :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- parent : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Int32 ->                                -- position : TBasicType TInt
    Ptr Int32 ->                            -- columns : TCArray False (-1) 6 (TBasicType TInt)
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 6 TGValue
    Int32 ->                                -- n_values : TBasicType TInt
    IO ()

{-# DEPRECATED treeStoreInsertWithValues ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | A variant of @/gtk_tree_store_insert_with_values()/@ which takes
-- the columns and values as two arrays, instead of varargs.
-- 
-- This function is mainly intended for language bindings.
treeStoreInsertWithValues ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@parent@/: A valid @GtkTreeIter@
    -> Int32
    -- ^ /@position@/: position to insert the new row, or -1 for last
    -> [Int32]
    -- ^ /@columns@/: an array of column numbers
    -> [GValue]
    -- ^ /@values@/: an array of GValues
    -> m (Gtk.TreeIter.TreeIter)
treeStoreInsertWithValues :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> Maybe TreeIter -> Int32 -> [Int32] -> [GValue] -> m TreeIter
treeStoreInsertWithValues a
treeStore Maybe TreeIter
parent Int32
position [Int32]
columns [GValue]
values = IO TreeIter -> m TreeIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeIter -> m TreeIter) -> IO TreeIter -> m TreeIter
forall a b. (a -> b) -> a -> b
$ do
    let nValues :: Int32
nValues = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let columns_expected_length_ :: Int32
columns_expected_length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
columns
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
columns_expected_length_ Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
nValues) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Gtk.treeStoreInsertWithValues : length of 'columns' does not agree with that of 'values'."
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
    maybeParent <- case parent of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jParent -> do
            jParent' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jParent
            return jParent'
    columns' <- packStorableArray columns
    values' <- B.GValue.packGValueArray values
    gtk_tree_store_insert_with_valuesv treeStore' iter maybeParent position columns' values' nValues
    iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
    touchManagedPtr treeStore
    whenJust parent touchManagedPtr
    mapM_ touchManagedPtr values
    freeMem columns'
    freeMem values'
    return iter'

#if defined(ENABLE_OVERLOADING)
data TreeStoreInsertWithValuesMethodInfo
instance (signature ~ (Maybe (Gtk.TreeIter.TreeIter) -> Int32 -> [Int32] -> [GValue] -> m (Gtk.TreeIter.TreeIter)), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreInsertWithValuesMethodInfo a signature where
    overloadedMethod = treeStoreInsertWithValues

instance O.OverloadedMethodInfo TreeStoreInsertWithValuesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreInsertWithValues",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreInsertWithValues"
        })


#endif

-- method TreeStore::is_ancestor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "descendant"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_is_ancestor" gtk_tree_store_is_ancestor :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- descendant : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO CInt

{-# DEPRECATED treeStoreIsAncestor ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Checks if /@iter@/ is an ancestor of /@descendant@/.
treeStoreIsAncestor ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A valid @GtkTreeIter@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@descendant@/: A valid @GtkTreeIter@
    -> m Bool
    -- ^ __Returns:__ true if /@iter@/ is an ancestor of /@descendant@/, and false otherwise
treeStoreIsAncestor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> TreeIter -> m Bool
treeStoreIsAncestor a
treeStore TreeIter
iter TreeIter
descendant = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    descendant' <- unsafeManagedPtrGetPtr descendant
    result <- gtk_tree_store_is_ancestor treeStore' iter' descendant'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr treeStore
    touchManagedPtr iter
    touchManagedPtr descendant
    return result'

#if defined(ENABLE_OVERLOADING)
data TreeStoreIsAncestorMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> Gtk.TreeIter.TreeIter -> m Bool), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreIsAncestorMethodInfo a signature where
    overloadedMethod = treeStoreIsAncestor

instance O.OverloadedMethodInfo TreeStoreIsAncestorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreIsAncestor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreIsAncestor"
        })


#endif

-- method TreeStore::iter_depth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_iter_depth" gtk_tree_store_iter_depth :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO Int32

{-# DEPRECATED treeStoreIterDepth ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Returns the depth of the position pointed by the iterator
-- 
-- The depth will be 0 for anything on the root level, 1 for anything down
-- a level, etc.
treeStoreIterDepth ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A valid @GtkTreeIter@
    -> m Int32
    -- ^ __Returns:__ The depth of the position pointed by the iterator
treeStoreIterDepth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> m Int32
treeStoreIterDepth a
treeStore TreeIter
iter = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    result <- gtk_tree_store_iter_depth treeStore' iter'
    touchManagedPtr treeStore
    touchManagedPtr iter
    return result

#if defined(ENABLE_OVERLOADING)
data TreeStoreIterDepthMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m Int32), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreIterDepthMethodInfo a signature where
    overloadedMethod = treeStoreIterDepth

instance O.OverloadedMethodInfo TreeStoreIterDepthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreIterDepth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreIterDepth"
        })


#endif

-- method TreeStore::iter_is_valid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tree store" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the iterator to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_iter_is_valid" gtk_tree_store_iter_is_valid :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO CInt

{-# DEPRECATED treeStoreIterIsValid ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Checks if the given iter is a valid iter for this @GtkTreeStore@.
-- 
-- This function is slow. Only use it for debugging and\/or testing
-- purposes.
treeStoreIterIsValid ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: a tree store
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: the iterator to check
    -> m Bool
    -- ^ __Returns:__ true if the iter is valid, and false otherwise
treeStoreIterIsValid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> m Bool
treeStoreIterIsValid a
treeStore TreeIter
iter = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    result <- gtk_tree_store_iter_is_valid treeStore' iter'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr treeStore
    touchManagedPtr iter
    return result'

#if defined(ENABLE_OVERLOADING)
data TreeStoreIterIsValidMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m Bool), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreIterIsValidMethodInfo a signature where
    overloadedMethod = treeStoreIterIsValid

instance O.OverloadedMethodInfo TreeStoreIterIsValidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreIterIsValid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreIterIsValid"
        })


#endif

-- method TreeStore::move_after
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeIter`." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeIter`." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_move_after" gtk_tree_store_move_after :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- position : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStoreMoveAfter ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Moves /@iter@/ in /@treeStore@/ to the position after /@position@/.
-- 
-- /@iter@/ and /@position@/ should be in the same level.
-- 
-- Note that this function only works with unsorted stores.
-- 
-- If /@position@/ is 'P.Nothing', /@iter@/ will be moved to the start of the level.
treeStoreMoveAfter ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A @GtkTreeIter@.
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@position@/: A @GtkTreeIter@.
    -> m ()
treeStoreMoveAfter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> Maybe TreeIter -> m ()
treeStoreMoveAfter a
treeStore TreeIter
iter Maybe TreeIter
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
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    maybePosition <- case position of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jPosition -> do
            jPosition' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jPosition
            return jPosition'
    gtk_tree_store_move_after treeStore' iter' maybePosition
    touchManagedPtr treeStore
    touchManagedPtr iter
    whenJust position touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreMoveAfterMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> Maybe (Gtk.TreeIter.TreeIter) -> m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreMoveAfterMethodInfo a signature where
    overloadedMethod = treeStoreMoveAfter

instance O.OverloadedMethodInfo TreeStoreMoveAfterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreMoveAfter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreMoveAfter"
        })


#endif

-- method TreeStore::move_before
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeIter`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeIter`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_move_before" gtk_tree_store_move_before :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- position : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStoreMoveBefore ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Moves /@iter@/ in /@treeStore@/ to the position before /@position@/.
-- 
-- /@iter@/ and /@position@/ should be in the same level.
-- 
-- Note that this function only works with unsorted stores.
-- 
-- If /@position@/ is 'P.Nothing', /@iter@/ will be moved to the end of the level.
treeStoreMoveBefore ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A @GtkTreeIter@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@position@/: A @GtkTreeIter@
    -> m ()
treeStoreMoveBefore :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> Maybe TreeIter -> m ()
treeStoreMoveBefore a
treeStore TreeIter
iter Maybe TreeIter
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
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    maybePosition <- case position of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jPosition -> do
            jPosition' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jPosition
            return jPosition'
    gtk_tree_store_move_before treeStore' iter' maybePosition
    touchManagedPtr treeStore
    touchManagedPtr iter
    whenJust position touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreMoveBeforeMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> Maybe (Gtk.TreeIter.TreeIter) -> m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreMoveBeforeMethodInfo a signature where
    overloadedMethod = treeStoreMoveBefore

instance O.OverloadedMethodInfo TreeStoreMoveBeforeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreMoveBefore",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreMoveBefore"
        })


#endif

-- method TreeStore::prepend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "An unset `GtkTreeIter` to set to the prepended row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_prepend" gtk_tree_store_prepend :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- parent : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStorePrepend ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Prepends a new row to /@treeStore@/.
-- 
-- If /@parent@/ is non-'P.Nothing', then it will prepend the new row before the first
-- child of /@parent@/, otherwise it will prepend a row to the top level. The
-- @iter@ parameter will be changed to point to this new row.  The row will
-- be empty after this function is called. To fill in values, you need to
-- call @/gtk_tree_store_set()/@ or 'GI.Gtk.Objects.TreeStore.treeStoreSetValue'.
treeStorePrepend ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Maybe (Gtk.TreeIter.TreeIter)
    -- ^ /@parent@/: A valid @GtkTreeIter@
    -> m (Gtk.TreeIter.TreeIter)
treeStorePrepend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> Maybe TreeIter -> m TreeIter
treeStorePrepend a
treeStore Maybe TreeIter
parent = IO TreeIter -> m TreeIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeIter -> m TreeIter) -> IO TreeIter -> m TreeIter
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
    maybeParent <- case parent of
        Maybe TreeIter
Nothing -> Ptr TreeIter -> IO (Ptr TreeIter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TreeIter
forall a. Ptr a
FP.nullPtr
        Just TreeIter
jParent -> do
            jParent' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
jParent
            return jParent'
    gtk_tree_store_prepend treeStore' iter maybeParent
    iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
    touchManagedPtr treeStore
    whenJust parent touchManagedPtr
    return iter'

#if defined(ENABLE_OVERLOADING)
data TreeStorePrependMethodInfo
instance (signature ~ (Maybe (Gtk.TreeIter.TreeIter) -> m (Gtk.TreeIter.TreeIter)), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStorePrependMethodInfo a signature where
    overloadedMethod = treeStorePrepend

instance O.OverloadedMethodInfo TreeStorePrependMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStorePrepend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStorePrepend"
        })


#endif

-- method TreeStore::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid `GtkTreeIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_remove" gtk_tree_store_remove :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO CInt

{-# DEPRECATED treeStoreRemove ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Removes /@iter@/ from /@treeStore@/.
-- 
-- After being removed, /@iter@/ is set to the next valid row at that level, or
-- invalidated if it previously pointed to the last one.
treeStoreRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A valid @GtkTreeIter@
    -> m Bool
    -- ^ __Returns:__ true if /@iter@/ is still valid, and false otherwise
treeStoreRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> m Bool
treeStoreRemove a
treeStore TreeIter
iter = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    result <- gtk_tree_store_remove treeStore' iter'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr treeStore
    touchManagedPtr iter
    return result'

#if defined(ENABLE_OVERLOADING)
data TreeStoreRemoveMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m Bool), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreRemoveMethodInfo a signature where
    overloadedMethod = treeStoreRemove

instance O.OverloadedMethodInfo TreeStoreRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreRemove"
        })


#endif

-- method TreeStore::set_column_types
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of columns for the tree store"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType = TCArray False (-1) 1 (TBasicType TGType)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "An array of `GType` types, one for each column"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Number of columns for the tree store"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_set_column_types" gtk_tree_store_set_column_types :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Int32 ->                                -- n_columns : TBasicType TInt
    Ptr CGType ->                           -- types : TCArray False (-1) 1 (TBasicType TGType)
    IO ()

{-# DEPRECATED treeStoreSetColumnTypes ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Sets the type of the columns in a tree store.
-- 
-- This function is meant primarily for types that inherit from
-- @GtkTreeStore@, and should only be used when constructing a new
-- @GtkTreeStore@.
-- 
-- This functions cannot be called after a row has been added,
-- or a method on the @GtkTreeModel@ interface is called on the
-- tree store.
treeStoreSetColumnTypes ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> [GType]
    -- ^ /@types@/: An array of @GType@ types, one for each column
    -> m ()
treeStoreSetColumnTypes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> [GType] -> m ()
treeStoreSetColumnTypes a
treeStore [GType]
types = 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 nColumns :: Int32
nColumns = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GType]
types
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    types' <- (packMapStorableArray gtypeToCGType) types
    gtk_tree_store_set_column_types treeStore' nColumns types'
    touchManagedPtr treeStore
    freeMem types'
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreSetColumnTypesMethodInfo
instance (signature ~ ([GType] -> m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreSetColumnTypesMethodInfo a signature where
    overloadedMethod = treeStoreSetColumnTypes

instance O.OverloadedMethodInfo TreeStoreSetColumnTypesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreSetColumnTypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreSetColumnTypes"
        })


#endif

-- method TreeStore::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid `GtkTreeIter` for the row being modified"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "column number to modify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new value for the cell"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_set_value" gtk_tree_store_set_value :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Int32 ->                                -- column : TBasicType TInt
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED treeStoreSetValue ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Sets the data in the cell specified by /@iter@/ and /@column@/.
-- 
-- The type of /@value@/ must be convertible to the type of the
-- column.
treeStoreSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: a @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A valid @GtkTreeIter@ for the row being modified
    -> Int32
    -- ^ /@column@/: column number to modify
    -> GValue
    -- ^ /@value@/: new value for the cell
    -> m ()
treeStoreSetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> Int32 -> GValue -> m ()
treeStoreSetValue a
treeStore TreeIter
iter Int32
column GValue
value = 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
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    value' <- unsafeManagedPtrGetPtr value
    gtk_tree_store_set_value treeStore' iter' column value'
    touchManagedPtr treeStore
    touchManagedPtr iter
    touchManagedPtr value
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreSetValueMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> Int32 -> GValue -> m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreSetValueMethodInfo a signature where
    overloadedMethod = treeStoreSetValue

instance O.OverloadedMethodInfo TreeStoreSetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreSetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreSetValue"
        })


#endif

-- method TreeStore::set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid `GtkTreeIter` for the row being modified"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TCArray False (-1) 4 (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of column numbers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 4 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of GValues"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_values"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the @columns and @values arrays"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_values"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the @columns and @values arrays"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_values"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the @columns and @values arrays"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_set_valuesv" gtk_tree_store_set_valuesv :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Int32 ->                            -- columns : TCArray False (-1) 4 (TBasicType TInt)
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 4 TGValue
    Int32 ->                                -- n_values : TBasicType TInt
    IO ()

{-# DEPRECATED treeStoreSet ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | A variant of @/gtk_tree_store_set_valist()/@ which takes
-- the columns and values as two arrays, instead of using variadic
-- arguments.
-- 
-- This function is mainly intended for language bindings or in case
-- the number of columns to change is not known until run-time.
treeStoreSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@
    -> Gtk.TreeIter.TreeIter
    -- ^ /@iter@/: A valid @GtkTreeIter@ for the row being modified
    -> [Int32]
    -- ^ /@columns@/: an array of column numbers
    -> [GValue]
    -- ^ /@values@/: an array of GValues
    -> m ()
treeStoreSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> [Int32] -> [GValue] -> m ()
treeStoreSet a
treeStore TreeIter
iter [Int32]
columns [GValue]
values = 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 nValues :: Int32
nValues = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let columns_expected_length_ :: Int32
columns_expected_length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
columns
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
columns_expected_length_ Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
nValues) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Gtk.treeStoreSet : length of 'columns' does not agree with that of 'values'."
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    iter' <- unsafeManagedPtrGetPtr iter
    columns' <- packStorableArray columns
    values' <- B.GValue.packGValueArray values
    gtk_tree_store_set_valuesv treeStore' iter' columns' values' nValues
    touchManagedPtr treeStore
    touchManagedPtr iter
    mapM_ touchManagedPtr values
    freeMem columns'
    freeMem values'
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreSetMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> [Int32] -> [GValue] -> m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreSetMethodInfo a signature where
    overloadedMethod = treeStoreSet

instance O.OverloadedMethodInfo TreeStoreSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreSet"
        })


#endif

-- method TreeStore::swap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tree_store"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeStore" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeStore`." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A `GtkTreeIter`." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Another `GtkTreeIter`."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_store_swap" gtk_tree_store_swap :: 
    Ptr TreeStore ->                        -- tree_store : TInterface (Name {namespace = "Gtk", name = "TreeStore"})
    Ptr Gtk.TreeIter.TreeIter ->            -- a : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    Ptr Gtk.TreeIter.TreeIter ->            -- b : TInterface (Name {namespace = "Gtk", name = "TreeIter"})
    IO ()

{-# DEPRECATED treeStoreSwap ["(Since version 4.10)","Use t'GI.Gtk.Objects.TreeListModel.TreeListModel' instead"] #-}
-- | Swaps /@a@/ and /@b@/ in the same level of /@treeStore@/.
-- 
-- Note that this function only works with unsorted stores.
treeStoreSwap ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeStore a) =>
    a
    -- ^ /@treeStore@/: A @GtkTreeStore@.
    -> Gtk.TreeIter.TreeIter
    -- ^ /@a@/: A @GtkTreeIter@.
    -> Gtk.TreeIter.TreeIter
    -- ^ /@b@/: Another @GtkTreeIter@.
    -> m ()
treeStoreSwap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeStore a) =>
a -> TreeIter -> TreeIter -> m ()
treeStoreSwap a
treeStore TreeIter
a TreeIter
b = 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
    treeStore' <- a -> IO (Ptr TreeStore)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
treeStore
    a' <- unsafeManagedPtrGetPtr a
    b' <- unsafeManagedPtrGetPtr b
    gtk_tree_store_swap treeStore' a' b'
    touchManagedPtr treeStore
    touchManagedPtr a
    touchManagedPtr b
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeStoreSwapMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> Gtk.TreeIter.TreeIter -> m ()), MonadIO m, IsTreeStore a) => O.OverloadedMethod TreeStoreSwapMethodInfo a signature where
    overloadedMethod = treeStoreSwap

instance O.OverloadedMethodInfo TreeStoreSwapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeStore.treeStoreSwap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeStore.html#v:treeStoreSwap"
        })


#endif