{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.TreeListModel.TreeListModel' is a t'GI.Gio.Interfaces.ListModel.ListModel' implementation that can expand rows
-- by creating new child list 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                         ,
    noTreeListModel                         ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#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                     ,


-- ** 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#
-- | If 'P.False', the t'GI.Gio.Interfaces.ListModel.ListModel' 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.ManagedPtr as B.ManagedPtr
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 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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import {-# SOURCE #-} qualified GI.Gtk.Objects.TreeListRow as Gtk.TreeListRow

-- | Memory-managed wrapper type.
newtype TreeListModel = TreeListModel (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)
foreign import ccall "gtk_tree_list_model_get_type"
    c_gtk_tree_list_model_get_type :: IO GType

instance GObject TreeListModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_tree_list_model_get_type
    

-- | Convert 'TreeListModel' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue TreeListModel where
    toGValue :: TreeListModel -> IO GValue
toGValue o :: TreeListModel
o = do
        GType
gtype <- IO GType
c_gtk_tree_list_model_get_type
        TreeListModel -> (Ptr TreeListModel -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TreeListModel
o (GType
-> (GValue -> Ptr TreeListModel -> IO ())
-> Ptr TreeListModel
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr TreeListModel -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO TreeListModel
fromGValue gv :: GValue
gv = do
        Ptr TreeListModel
ptr <- GValue -> IO (Ptr TreeListModel)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr TreeListModel)
        (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
        
    

-- | Type class for types which can be safely cast to `TreeListModel`, for instance with `toTreeListModel`.
class (GObject o, O.IsDescendantOf TreeListModel o) => IsTreeListModel o
instance (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 :: (MonadIO m, IsTreeListModel o) => o -> m TreeListModel
toTreeListModel :: o -> m TreeListModel
toTreeListModel = IO TreeListModel -> m TreeListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr TreeListModel -> TreeListModel
TreeListModel

-- | A convenience alias for `Nothing` :: `Maybe` `TreeListModel`.
noTreeListModel :: Maybe TreeListModel
noTreeListModel :: Maybe TreeListModel
noTreeListModel = Maybe TreeListModel
forall a. Maybe a
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.MethodInfo 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

#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 :: o -> m Bool
getTreeListModelAutoexpand obj :: o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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 :: o -> Bool -> m ()
setTreeListModelAutoexpand obj :: o
obj val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj "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) => Bool -> IO (GValueConstruct o)
constructTreeListModelAutoexpand :: Bool -> IO (GValueConstruct o)
constructTreeListModelAutoexpand val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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 :: o -> m ListModel
getTreeListModelModel obj :: o
obj = 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
$ Text -> IO (Maybe ListModel) -> IO ListModel
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "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 "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
#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 :: o -> m Bool
getTreeListModelPassthrough obj :: o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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) => Bool -> IO (GValueConstruct o)
constructTreeListModelPassthrough :: Bool -> IO (GValueConstruct o)
constructTreeListModelPassthrough val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "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
#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::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 @/gtk_tree_list_model_set_expanded()/@.
treeListModelGetAutoexpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListModel.TreeListModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the model is set to autoexpand
treeListModelGetAutoexpand :: a -> m Bool
treeListModelGetAutoexpand self :: 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
/= 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.MethodInfo TreeListModelGetAutoexpandMethodInfo a signature where
    overloadedMethod = 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 t'GI.Gtk.Objects.TreeListModel.TreeListModel'
    -> Word32
    -- ^ /@position@/: position of the child to get
    -> m (Maybe Gtk.TreeListRow.TreeListRow)
    -- ^ __Returns:__ the child in /@position@/
treeListModelGetChildRow :: a -> Word32 -> m (Maybe TreeListRow)
treeListModelGetChildRow self :: a
self position :: 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
$ \result' :: 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.MethodInfo TreeListModelGetChildRowMethodInfo a signature where
    overloadedMethod = 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 t'GI.Gtk.Objects.TreeListModel.TreeListModel'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ the root model
treeListModelGetModel :: a -> m ListModel
treeListModelGetModel self :: 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 "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.MethodInfo TreeListModelGetModelMethodInfo a signature where
    overloadedMethod = 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

-- | If this function returns 'P.False', the t'GI.Gio.Interfaces.ListModel.ListModel' functions for /@self@/
-- return custom t'GI.Gtk.Objects.TreeListRow.TreeListRow' 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 @/GtkTreeListRows/@.
treeListModelGetPassthrough ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListModel.TreeListModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the model is passing through original row items
treeListModelGetPassthrough :: a -> m Bool
treeListModelGetPassthrough self :: 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
/= 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.MethodInfo TreeListModelGetPassthroughMethodInfo a signature where
    overloadedMethod = 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 t'GI.Gtk.Objects.TreeListModel.TreeListModel'
    -> Word32
    -- ^ /@position@/: the position of the row to fetch
    -> m (Maybe Gtk.TreeListRow.TreeListRow)
    -- ^ __Returns:__ The row item
treeListModelGetRow :: a -> Word32 -> m (Maybe TreeListRow)
treeListModelGetRow self :: a
self position :: 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
$ \result' :: 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.MethodInfo TreeListModelGetRowMethodInfo a signature where
    overloadedMethod = 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 ()

-- | 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 @/gtk_tree_list_model_set_expanded()/@.
treeListModelSetAutoexpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListModel.TreeListModel'
    -> Bool
    -- ^ /@autoexpand@/: 'P.True' to make the model autoexpand its rows
    -> m ()
treeListModelSetAutoexpand :: a -> Bool -> m ()
treeListModelSetAutoexpand self :: a
self autoexpand :: 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.MethodInfo TreeListModelSetAutoexpandMethodInfo a signature where
    overloadedMethod = treeListModelSetAutoexpand

#endif