{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkTreeListModel@ is 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


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

#if defined(ENABLE_OVERLOADING)
    TreeListModelModelPropertyInfo          ,
#endif
    getTreeListModelModel                   ,
#if defined(ENABLE_OVERLOADING)
    treeListModelModel                      ,
#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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.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

-- | 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
/= :: TreeListModel -> TreeListModel -> Bool
$c/= :: TreeListModel -> TreeListModel -> Bool
== :: TreeListModel -> TreeListModel -> Bool
$c== :: 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 `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 `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 (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 'TreeListModel' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe 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 TreeListModel
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 TreeListModel
ptr Ptr TreeListModel -> Ptr TreeListModel -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TreeListModel
forall a. Ptr a
FP.nullPtr
        then TreeListModel -> Maybe TreeListModel
forall a. a -> Maybe a
P.Just (TreeListModel -> Maybe TreeListModel)
-> IO TreeListModel -> IO (Maybe TreeListModel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr TreeListModel -> TreeListModel)
-> Ptr TreeListModel -> IO TreeListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr TreeListModel -> TreeListModel
TreeListModel Ptr TreeListModel
ptr
        else Maybe TreeListModel -> IO (Maybe TreeListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeListModel
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTreeListModelMethod (t :: Symbol) (o :: *) :: * 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 (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 (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 `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 (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 (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-gtk-4.0.5/docs/GI-Gtk-Objects-TreeListModel.html#g:attr:autoexpand"
        })
#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 (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-gtk-4.0.5/docs/GI-Gtk-Objects-TreeListModel.html#g:attr:model"
        })
#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 (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 `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 (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 (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-gtk-4.0.5/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), '("model", TreeListModelModelPropertyInfo), '("passthrough", TreeListModelPassthroughPropertyInfo)] :: [(Symbol, *)])
#endif

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

treeListModelModel :: AttrLabelProxy "model"
treeListModelModel = 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, *)])

#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
--           , 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
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "create_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "TreeListModelCreateModelFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Function to call to create the `GListModel` for the children\n  of an item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 4
--           , argDestroy = 5
--           , argCallerAllocates = 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
--           , 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
--           , 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 (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
    Ptr ListModel
root' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
root
    let passthrough' :: CInt
passthrough' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
passthrough
    let autoexpand' :: CInt
autoexpand' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
autoexpand
    FunPtr C_TreeListModelCreateModelFunc
createFunc' <- C_TreeListModelCreateModelFunc
-> IO (FunPtr C_TreeListModelCreateModelFunc)
Gtk.Callbacks.mk_TreeListModelCreateModelFunc (Maybe (Ptr (FunPtr C_TreeListModelCreateModelFunc))
-> TreeListModelCreateModelFunc_WithClosures
-> C_TreeListModelCreateModelFunc
Gtk.Callbacks.wrap_TreeListModelCreateModelFunc Maybe (Ptr (FunPtr C_TreeListModelCreateModelFunc))
forall a. Maybe a
Nothing (TreeListModelCreateModelFunc
-> TreeListModelCreateModelFunc_WithClosures
Gtk.Callbacks.drop_closures_TreeListModelCreateModelFunc TreeListModelCreateModelFunc
createFunc))
    let userData :: Ptr ()
userData = FunPtr C_TreeListModelCreateModelFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TreeListModelCreateModelFunc
createFunc'
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr TreeListModel
result <- Ptr ListModel
-> CInt
-> CInt
-> FunPtr C_TreeListModelCreateModelFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr TreeListModel)
gtk_tree_list_model_new Ptr ListModel
root' CInt
passthrough' CInt
autoexpand' FunPtr C_TreeListModelCreateModelFunc
createFunc' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    Text -> Ptr TreeListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeListModelNew" Ptr TreeListModel
result
    TreeListModel
result' <- ((ManagedPtr TreeListModel -> TreeListModel)
-> Ptr TreeListModel -> IO TreeListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TreeListModel -> TreeListModel
TreeListModel) Ptr TreeListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
root
    TreeListModel -> IO TreeListModel
forall (m :: * -> *) a. Monad m => a -> m a
return TreeListModel
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
--           , 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListModel
self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TreeListModel -> IO CInt
gtk_tree_list_model_get_autoexpand Ptr TreeListModel
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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-gtk-4.0.5/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
--           , 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
--           , 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 (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
    Ptr TreeListModel
self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TreeListRow
result <- Ptr TreeListModel -> Word32 -> IO (Ptr TreeListRow)
gtk_tree_list_model_get_child_row Ptr TreeListModel
self' Word32
position
    Maybe TreeListRow
maybeResult <- Ptr TreeListRow
-> (Ptr TreeListRow -> IO TreeListRow) -> IO (Maybe TreeListRow)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TreeListRow
result ((Ptr TreeListRow -> IO TreeListRow) -> IO (Maybe TreeListRow))
-> (Ptr TreeListRow -> IO TreeListRow) -> IO (Maybe TreeListRow)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeListRow
result' -> do
        TreeListRow
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'
        TreeListRow -> IO TreeListRow
forall (m :: * -> *) a. Monad m => a -> m a
return TreeListRow
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe TreeListRow -> IO (Maybe TreeListRow)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeListRow
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-gtk-4.0.5/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
--           , 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 (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
    Ptr TreeListModel
self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr TreeListModel -> IO (Ptr ListModel)
gtk_tree_list_model_get_model Ptr TreeListModel
self'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeListModelGetModel" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ListModel -> IO ListModel
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
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-gtk-4.0.5/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
--           , 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListModel
self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TreeListModel -> IO CInt
gtk_tree_list_model_get_passthrough Ptr TreeListModel
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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-gtk-4.0.5/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
--           , 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
--           , 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 (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
    Ptr TreeListModel
self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TreeListRow
result <- Ptr TreeListModel -> Word32 -> IO (Ptr TreeListRow)
gtk_tree_list_model_get_row Ptr TreeListModel
self' Word32
position
    Maybe TreeListRow
maybeResult <- Ptr TreeListRow
-> (Ptr TreeListRow -> IO TreeListRow) -> IO (Maybe TreeListRow)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TreeListRow
result ((Ptr TreeListRow -> IO TreeListRow) -> IO (Maybe TreeListRow))
-> (Ptr TreeListRow -> IO TreeListRow) -> IO (Maybe TreeListRow)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeListRow
result' -> do
        TreeListRow
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'
        TreeListRow -> IO TreeListRow
forall (m :: * -> *) a. Monad m => a -> m a
return TreeListRow
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe TreeListRow -> IO (Maybe TreeListRow)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeListRow
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-gtk-4.0.5/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
--           , 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
--           , 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListModel
self' <- a -> IO (Ptr TreeListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let autoexpand' :: CInt
autoexpand' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
autoexpand
    Ptr TreeListModel -> CInt -> IO ()
gtk_tree_list_model_set_autoexpand Ptr TreeListModel
self' CInt
autoexpand'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.5/docs/GI-Gtk-Objects-TreeListModel.html#v:treeListModelSetAutoexpand"
        })


#endif