{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A list model that can create child models on demand.

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

module GI.Gtk.Objects.TreeListModel
    ( 

-- * Exported types
    TreeListModel(..)                       ,
    IsTreeListModel                         ,
    toTreeListModel                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTreeListModelMethod              ,
#endif

-- ** getAutoexpand #method:getAutoexpand#

#if defined(ENABLE_OVERLOADING)
    TreeListModelGetAutoexpandMethodInfo    ,
#endif
    treeListModelGetAutoexpand              ,


-- ** getChildRow #method:getChildRow#

#if defined(ENABLE_OVERLOADING)
    TreeListModelGetChildRowMethodInfo      ,
#endif
    treeListModelGetChildRow                ,


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    TreeListModelGetModelMethodInfo         ,
#endif
    treeListModelGetModel                   ,


-- ** getPassthrough #method:getPassthrough#

#if defined(ENABLE_OVERLOADING)
    TreeListModelGetPassthroughMethodInfo   ,
#endif
    treeListModelGetPassthrough             ,


-- ** getRow #method:getRow#

#if defined(ENABLE_OVERLOADING)
    TreeListModelGetRowMethodInfo           ,
#endif
    treeListModelGetRow                     ,


-- ** new #method:new#

    treeListModelNew                        ,


-- ** setAutoexpand #method:setAutoexpand#

#if defined(ENABLE_OVERLOADING)
    TreeListModelSetAutoexpandMethodInfo    ,
#endif
    treeListModelSetAutoexpand              ,




 -- * Properties


-- ** autoexpand #attr:autoexpand#
-- | If all rows should be expanded by default.

#if defined(ENABLE_OVERLOADING)
    TreeListModelAutoexpandPropertyInfo     ,
#endif
    constructTreeListModelAutoexpand        ,
    getTreeListModelAutoexpand              ,
    setTreeListModelAutoexpand              ,
#if defined(ENABLE_OVERLOADING)
    treeListModelAutoexpand                 ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TreeListModelItemTypePropertyInfo       ,
#endif
    getTreeListModelItemType                ,
#if defined(ENABLE_OVERLOADING)
    treeListModelItemType                   ,
#endif


-- ** model #attr:model#
-- | The root model displayed.

#if defined(ENABLE_OVERLOADING)
    TreeListModelModelPropertyInfo          ,
#endif
    getTreeListModelModel                   ,
#if defined(ENABLE_OVERLOADING)
    treeListModelModel                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TreeListModelNItemsPropertyInfo         ,
#endif
    getTreeListModelNItems                  ,
#if defined(ENABLE_OVERLOADING)
    treeListModelNItems                     ,
#endif


-- ** passthrough #attr:passthrough#
-- | Gets whether the model is in passthrough mode.
-- 
-- If 'P.False', the @GListModel@ functions for this object return custom
-- t'GI.Gtk.Objects.TreeListRow.TreeListRow' objects. If 'P.True', the values of the child
-- models are pass through unmodified.

#if defined(ENABLE_OVERLOADING)
    TreeListModelPassthroughPropertyInfo    ,
#endif
    constructTreeListModelPassthrough       ,
    getTreeListModelPassthrough             ,
#if defined(ENABLE_OVERLOADING)
    treeListModelPassthrough                ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified 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.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Objects.TreeListRow as Gtk.TreeListRow

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

#endif

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

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

foreign import ccall "gtk_tree_list_model_get_type"
    c_gtk_tree_list_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject TreeListModel where
    glibType :: IO GType
glibType = IO GType
c_gtk_tree_list_model_get_type

instance B.Types.GObject TreeListModel

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTreeListModelMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTreeListModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTreeListModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTreeListModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTreeListModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTreeListModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTreeListModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTreeListModelMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveTreeListModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTreeListModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTreeListModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTreeListModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTreeListModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTreeListModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTreeListModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTreeListModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTreeListModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTreeListModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTreeListModelMethod "getAutoexpand" o = TreeListModelGetAutoexpandMethodInfo
    ResolveTreeListModelMethod "getChildRow" o = TreeListModelGetChildRowMethodInfo
    ResolveTreeListModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTreeListModelMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveTreeListModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveTreeListModelMethod "getModel" o = TreeListModelGetModelMethodInfo
    ResolveTreeListModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveTreeListModelMethod "getPassthrough" o = TreeListModelGetPassthroughMethodInfo
    ResolveTreeListModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTreeListModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTreeListModelMethod "getRow" o = TreeListModelGetRowMethodInfo
    ResolveTreeListModelMethod "setAutoexpand" o = TreeListModelSetAutoexpandMethodInfo
    ResolveTreeListModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTreeListModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTreeListModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTreeListModelMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TreeListModelAutoexpandPropertyInfo
instance AttrInfo TreeListModelAutoexpandPropertyInfo where
    type AttrAllowedOps TreeListModelAutoexpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TreeListModelAutoexpandPropertyInfo = IsTreeListModel
    type AttrSetTypeConstraint TreeListModelAutoexpandPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TreeListModelAutoexpandPropertyInfo = (~) Bool
    type AttrTransferType TreeListModelAutoexpandPropertyInfo = Bool
    type AttrGetType TreeListModelAutoexpandPropertyInfo = Bool
    type AttrLabel TreeListModelAutoexpandPropertyInfo = "autoexpand"
    type AttrOrigin TreeListModelAutoexpandPropertyInfo = TreeListModel
    attrGet = getTreeListModelAutoexpand
    attrSet = setTreeListModelAutoexpand
    attrTransfer _ v = do
        return v
    attrConstruct = constructTreeListModelAutoexpand
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeListModel.autoexpand"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeListModel.html#g:attr:autoexpand"
        })
#endif

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TreeListModelModelPropertyInfo
instance AttrInfo TreeListModelModelPropertyInfo where
    type AttrAllowedOps TreeListModelModelPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TreeListModelModelPropertyInfo = IsTreeListModel
    type AttrSetTypeConstraint TreeListModelModelPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TreeListModelModelPropertyInfo = (~) ()
    type AttrTransferType TreeListModelModelPropertyInfo = ()
    type AttrGetType TreeListModelModelPropertyInfo = Gio.ListModel.ListModel
    type AttrLabel TreeListModelModelPropertyInfo = "model"
    type AttrOrigin TreeListModelModelPropertyInfo = TreeListModel
    attrGet = getTreeListModelModel
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeListModel.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeListModel.html#g:attr:model"
        })
#endif

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TreeListModelPassthroughPropertyInfo
instance AttrInfo TreeListModelPassthroughPropertyInfo where
    type AttrAllowedOps TreeListModelPassthroughPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TreeListModelPassthroughPropertyInfo = IsTreeListModel
    type AttrSetTypeConstraint TreeListModelPassthroughPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TreeListModelPassthroughPropertyInfo = (~) Bool
    type AttrTransferType TreeListModelPassthroughPropertyInfo = Bool
    type AttrGetType TreeListModelPassthroughPropertyInfo = Bool
    type AttrLabel TreeListModelPassthroughPropertyInfo = "passthrough"
    type AttrOrigin TreeListModelPassthroughPropertyInfo = TreeListModel
    attrGet = getTreeListModelPassthrough
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTreeListModelPassthrough
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.TreeListModel.passthrough"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeListModel.html#g:attr:passthrough"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TreeListModel
type instance O.AttributeList TreeListModel = TreeListModelAttributeList
type TreeListModelAttributeList = ('[ '("autoexpand", TreeListModelAutoexpandPropertyInfo), '("itemType", TreeListModelItemTypePropertyInfo), '("model", TreeListModelModelPropertyInfo), '("nItems", TreeListModelNItemsPropertyInfo), '("passthrough", TreeListModelPassthroughPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
treeListModelAutoexpand :: AttrLabelProxy "autoexpand"
treeListModelAutoexpand = AttrLabelProxy

treeListModelItemType :: AttrLabelProxy "itemType"
treeListModelItemType = AttrLabelProxy

treeListModelModel :: AttrLabelProxy "model"
treeListModelModel = AttrLabelProxy

treeListModelNItems :: AttrLabelProxy "nItems"
treeListModelNItems = AttrLabelProxy

treeListModelPassthrough :: AttrLabelProxy "passthrough"
treeListModelPassthrough = AttrLabelProxy

#endif

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

#endif

-- method TreeListModel::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "root"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The `GListModel` to use as root"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "passthrough"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to pass through items from the models"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "autoexpand"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE to set the autoexpand property and expand the @root model"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "create_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "TreeListModelCreateModelFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to\n  call to create the `GListModel` for the children of an item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 4
--           , argDestroy = 5
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data to pass to @create_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Function to call to free @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "TreeListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_list_model_new" gtk_tree_list_model_new :: 
    Ptr Gio.ListModel.ListModel ->          -- root : TInterface (Name {namespace = "Gio", name = "ListModel"})
    CInt ->                                 -- passthrough : TBasicType TBoolean
    CInt ->                                 -- autoexpand : TBasicType TBoolean
    FunPtr Gtk.Callbacks.C_TreeListModelCreateModelFunc -> -- create_func : TInterface (Name {namespace = "Gtk", name = "TreeListModelCreateModelFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr TreeListModel)

-- | Creates a new empty @GtkTreeListModel@ displaying /@root@/
-- with all rows collapsed.
treeListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    a
    -- ^ /@root@/: The @GListModel@ to use as root
    -> Bool
    -- ^ /@passthrough@/: 'P.True' to pass through items from the models
    -> Bool
    -- ^ /@autoexpand@/: 'P.True' to set the autoexpand property and expand the /@root@/ model
    -> Gtk.Callbacks.TreeListModelCreateModelFunc
    -- ^ /@createFunc@/: function to
    --   call to create the @GListModel@ for the children of an item
    -> m TreeListModel
    -- ^ __Returns:__ a newly created @GtkTreeListModel@.
treeListModelNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
a
-> Bool -> Bool -> TreeListModelCreateModelFunc -> m TreeListModel
treeListModelNew a
root Bool
passthrough Bool
autoexpand TreeListModelCreateModelFunc
createFunc = IO TreeListModel -> m TreeListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeListModel -> m TreeListModel)
-> IO TreeListModel -> m TreeListModel
forall a b. (a -> b) -> a -> b
$ do
    root' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
root
    let passthrough' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
passthrough
    let autoexpand' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
autoexpand
    createFunc' <- Gtk.Callbacks.mk_TreeListModelCreateModelFunc (Gtk.Callbacks.wrap_TreeListModelCreateModelFunc Nothing (Gtk.Callbacks.drop_closures_TreeListModelCreateModelFunc createFunc))
    let userData = FunPtr C_TreeListModelCreateModelFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TreeListModelCreateModelFunc
createFunc'
    let userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    result <- gtk_tree_list_model_new root' passthrough' autoexpand' createFunc' userData userDestroy
    checkUnexpectedReturnNULL "treeListModelNew" result
    result' <- (wrapObject TreeListModel) result
    touchManagedPtr root
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TreeListModel::get_autoexpand
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkTreeListModel`"
--                 , 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_list_model_get_autoexpand" gtk_tree_list_model_get_autoexpand :: 
    Ptr TreeListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "TreeListModel"})
    IO CInt

-- | Gets whether the model is set to automatically expand new rows
-- that get added.
-- 
-- This can be either rows added by changes to the underlying
-- models or via 'GI.Gtk.Objects.TreeListRow.treeListRowSetExpanded'.
treeListModelGetAutoexpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a @GtkTreeListModel@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the model is set to autoexpand
treeListModelGetAutoexpand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeListModel a) =>
a -> m Bool
treeListModelGetAutoexpand a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_tree_list_model_get_autoexpand self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TreeListModelGetAutoexpandMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeListModel a) => O.OverloadedMethod TreeListModelGetAutoexpandMethodInfo a signature where
    overloadedMethod = treeListModelGetAutoexpand

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


#endif

-- method TreeListModel::get_child_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkTreeListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position of the child to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "TreeListRow" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_list_model_get_child_row" gtk_tree_list_model_get_child_row :: 
    Ptr TreeListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "TreeListModel"})
    Word32 ->                               -- position : TBasicType TUInt
    IO (Ptr Gtk.TreeListRow.TreeListRow)

-- | Gets the row item corresponding to the child at index /@position@/ for
-- /@self@/\'s root model.
-- 
-- If /@position@/ is greater than the number of children in the root model,
-- 'P.Nothing' is returned.
-- 
-- Do not confuse this function with 'GI.Gtk.Objects.TreeListModel.treeListModelGetRow'.
treeListModelGetChildRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a @GtkTreeListModel@
    -> Word32
    -- ^ /@position@/: position of the child to get
    -> m (Maybe Gtk.TreeListRow.TreeListRow)
    -- ^ __Returns:__ the child in /@position@/
treeListModelGetChildRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeListModel a) =>
a -> Word32 -> m (Maybe TreeListRow)
treeListModelGetChildRow a
self Word32
position = IO (Maybe TreeListRow) -> m (Maybe TreeListRow)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TreeListRow) -> m (Maybe TreeListRow))
-> IO (Maybe TreeListRow) -> m (Maybe TreeListRow)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_tree_list_model_get_child_row self' position
    maybeResult <- convertIfNonNull result $ \Ptr TreeListRow
result' -> do
        result'' <- ((ManagedPtr TreeListRow -> TreeListRow)
-> Ptr TreeListRow -> IO TreeListRow
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TreeListRow -> TreeListRow
Gtk.TreeListRow.TreeListRow) Ptr TreeListRow
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data TreeListModelGetChildRowMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gtk.TreeListRow.TreeListRow)), MonadIO m, IsTreeListModel a) => O.OverloadedMethod TreeListModelGetChildRowMethodInfo a signature where
    overloadedMethod = treeListModelGetChildRow

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


#endif

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

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

-- | Gets the root model that /@self@/ was created with.
treeListModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a @GtkTreeListModel@
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ the root model
treeListModelGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeListModel a) =>
a -> m ListModel
treeListModelGetModel a
self = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_tree_list_model_get_model self'
    checkUnexpectedReturnNULL "treeListModelGetModel" result
    result' <- (newObject Gio.ListModel.ListModel) result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TreeListModelGetModelMethodInfo
instance (signature ~ (m Gio.ListModel.ListModel), MonadIO m, IsTreeListModel a) => O.OverloadedMethod TreeListModelGetModelMethodInfo a signature where
    overloadedMethod = treeListModelGetModel

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


#endif

-- method TreeListModel::get_passthrough
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkTreeListModel`"
--                 , 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_list_model_get_passthrough" gtk_tree_list_model_get_passthrough :: 
    Ptr TreeListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "TreeListModel"})
    IO CInt

-- | Gets whether the model is passing through original row items.
-- 
-- If this function returns 'P.False', the @GListModel@ functions for /@self@/
-- return custom @GtkTreeListRow@ objects. You need to call
-- 'GI.Gtk.Objects.TreeListRow.treeListRowGetItem' on these objects to get the original
-- item.
-- 
-- If 'P.True', the values of the child models are passed through in their
-- original state. You then need to call 'GI.Gtk.Objects.TreeListModel.treeListModelGetRow'
-- to get the custom @GtkTreeListRow@s.
treeListModelGetPassthrough ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a @GtkTreeListModel@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the model is passing through original row items
treeListModelGetPassthrough :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeListModel a) =>
a -> m Bool
treeListModelGetPassthrough a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_tree_list_model_get_passthrough self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TreeListModelGetPassthroughMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeListModel a) => O.OverloadedMethod TreeListModelGetPassthroughMethodInfo a signature where
    overloadedMethod = treeListModelGetPassthrough

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


#endif

-- method TreeListModel::get_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkTreeListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the row to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "TreeListRow" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_list_model_get_row" gtk_tree_list_model_get_row :: 
    Ptr TreeListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "TreeListModel"})
    Word32 ->                               -- position : TBasicType TUInt
    IO (Ptr Gtk.TreeListRow.TreeListRow)

-- | Gets the row object for the given row.
-- 
-- If /@position@/ is greater than the number of items in /@self@/,
-- 'P.Nothing' is returned.
-- 
-- The row object can be used to expand and collapse rows as
-- well as to inspect its position in the tree. See its
-- documentation for details.
-- 
-- This row object is persistent and will refer to the current
-- item as long as the row is present in /@self@/, independent of
-- other rows being added or removed.
-- 
-- If /@self@/ is set to not be passthrough, this function is
-- equivalent to calling @/g_list_model_get_item()/@.
-- 
-- Do not confuse this function with 'GI.Gtk.Objects.TreeListModel.treeListModelGetChildRow'.
treeListModelGetRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a @GtkTreeListModel@
    -> Word32
    -- ^ /@position@/: the position of the row to fetch
    -> m (Maybe Gtk.TreeListRow.TreeListRow)
    -- ^ __Returns:__ The row item
treeListModelGetRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeListModel a) =>
a -> Word32 -> m (Maybe TreeListRow)
treeListModelGetRow a
self Word32
position = IO (Maybe TreeListRow) -> m (Maybe TreeListRow)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TreeListRow) -> m (Maybe TreeListRow))
-> IO (Maybe TreeListRow) -> m (Maybe TreeListRow)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_tree_list_model_get_row self' position
    maybeResult <- convertIfNonNull result $ \Ptr TreeListRow
result' -> do
        result'' <- ((ManagedPtr TreeListRow -> TreeListRow)
-> Ptr TreeListRow -> IO TreeListRow
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TreeListRow -> TreeListRow
Gtk.TreeListRow.TreeListRow) Ptr TreeListRow
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data TreeListModelGetRowMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gtk.TreeListRow.TreeListRow)), MonadIO m, IsTreeListModel a) => O.OverloadedMethod TreeListModelGetRowMethodInfo a signature where
    overloadedMethod = treeListModelGetRow

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


#endif

-- method TreeListModel::set_autoexpand
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkTreeListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "autoexpand"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to make the model autoexpand its rows"
--                 , 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_list_model_set_autoexpand" gtk_tree_list_model_set_autoexpand :: 
    Ptr TreeListModel ->                    -- self : TInterface (Name {namespace = "Gtk", name = "TreeListModel"})
    CInt ->                                 -- autoexpand : TBasicType TBoolean
    IO ()

-- | Sets whether the model should autoexpand.
-- 
-- If set to 'P.True', the model will recursively expand all rows that
-- get added to the model. This can be either rows added by changes
-- to the underlying models or via 'GI.Gtk.Objects.TreeListRow.treeListRowSetExpanded'.
treeListModelSetAutoexpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a @GtkTreeListModel@
    -> Bool
    -- ^ /@autoexpand@/: 'P.True' to make the model autoexpand its rows
    -> m ()
treeListModelSetAutoexpand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeListModel a) =>
a -> Bool -> m ()
treeListModelSetAutoexpand a
self Bool
autoexpand = 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
    self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let autoexpand' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
autoexpand
    gtk_tree_list_model_set_autoexpand self' autoexpand'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data TreeListModelSetAutoexpandMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTreeListModel a) => O.OverloadedMethod TreeListModelSetAutoexpandMethodInfo a signature where
    overloadedMethod = treeListModelSetAutoexpand

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


#endif