{-# 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.TreeListRow.TreeListRow' is the object used by t'GI.Gtk.Objects.TreeListModel.TreeListModel' to
-- represent items. It allows navigating the model as a tree and
-- modify the state of rows.
-- 
-- t'GI.Gtk.Objects.TreeListRow.TreeListRow' instances are created by a t'GI.Gtk.Objects.TreeListModel.TreeListModel' only
-- when the t'GI.Gtk.Objects.TreeListModel.TreeListModel':@/passthrough/@ property is not set.
-- 
-- There are various support objects that can make use of t'GI.Gtk.Objects.TreeListRow.TreeListRow'
-- objects, such as the @/GtkTreeExpander/@ widget that allows displaying
-- an icon to expand or collapse a row or @/GtkTreeListRowSorter/@ that makes
-- it possible to sort trees properly.

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

module GI.Gtk.Objects.TreeListRow
    ( 

-- * Exported types
    TreeListRow(..)                         ,
    IsTreeListRow                           ,
    toTreeListRow                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTreeListRowMethod                ,
#endif


-- ** getChildRow #method:getChildRow#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetChildRowMethodInfo        ,
#endif
    treeListRowGetChildRow                  ,


-- ** getChildren #method:getChildren#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetChildrenMethodInfo        ,
#endif
    treeListRowGetChildren                  ,


-- ** getDepth #method:getDepth#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetDepthMethodInfo           ,
#endif
    treeListRowGetDepth                     ,


-- ** getExpanded #method:getExpanded#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetExpandedMethodInfo        ,
#endif
    treeListRowGetExpanded                  ,


-- ** getItem #method:getItem#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetItemMethodInfo            ,
#endif
    treeListRowGetItem                      ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetParentMethodInfo          ,
#endif
    treeListRowGetParent                    ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    TreeListRowGetPositionMethodInfo        ,
#endif
    treeListRowGetPosition                  ,


-- ** isExpandable #method:isExpandable#

#if defined(ENABLE_OVERLOADING)
    TreeListRowIsExpandableMethodInfo       ,
#endif
    treeListRowIsExpandable                 ,


-- ** setExpanded #method:setExpanded#

#if defined(ENABLE_OVERLOADING)
    TreeListRowSetExpandedMethodInfo        ,
#endif
    treeListRowSetExpanded                  ,




 -- * Properties
-- ** children #attr:children#
-- | The model holding the row\'s children.

#if defined(ENABLE_OVERLOADING)
    TreeListRowChildrenPropertyInfo         ,
#endif
    getTreeListRowChildren                  ,
#if defined(ENABLE_OVERLOADING)
    treeListRowChildren                     ,
#endif


-- ** depth #attr:depth#
-- | The depth in the tree of this row

#if defined(ENABLE_OVERLOADING)
    TreeListRowDepthPropertyInfo            ,
#endif
    getTreeListRowDepth                     ,
#if defined(ENABLE_OVERLOADING)
    treeListRowDepth                        ,
#endif


-- ** expandable #attr:expandable#
-- | If this row can ever be expanded

#if defined(ENABLE_OVERLOADING)
    TreeListRowExpandablePropertyInfo       ,
#endif
    getTreeListRowExpandable                ,
#if defined(ENABLE_OVERLOADING)
    treeListRowExpandable                   ,
#endif


-- ** expanded #attr:expanded#
-- | If this row is currently expanded

#if defined(ENABLE_OVERLOADING)
    TreeListRowExpandedPropertyInfo         ,
#endif
    constructTreeListRowExpanded            ,
    getTreeListRowExpanded                  ,
    setTreeListRowExpanded                  ,
#if defined(ENABLE_OVERLOADING)
    treeListRowExpanded                     ,
#endif


-- ** item #attr:item#
-- | The item held in this row

#if defined(ENABLE_OVERLOADING)
    TreeListRowItemPropertyInfo             ,
#endif
    getTreeListRowItem                      ,
#if defined(ENABLE_OVERLOADING)
    treeListRowItem                         ,
#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.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.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

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

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

foreign import ccall "gtk_tree_list_row_get_type"
    c_gtk_tree_list_row_get_type :: IO B.Types.GType

instance B.Types.TypedObject TreeListRow where
    glibType :: IO GType
glibType = IO GType
c_gtk_tree_list_row_get_type

instance B.Types.GObject TreeListRow

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

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

instance O.HasParentTypes TreeListRow
type instance O.ParentTypes TreeListRow = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTreeListRowMethod (t :: Symbol) (o :: *) :: * where
    ResolveTreeListRowMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTreeListRowMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTreeListRowMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTreeListRowMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTreeListRowMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTreeListRowMethod "isExpandable" o = TreeListRowIsExpandableMethodInfo
    ResolveTreeListRowMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTreeListRowMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTreeListRowMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTreeListRowMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTreeListRowMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTreeListRowMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTreeListRowMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTreeListRowMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTreeListRowMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTreeListRowMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTreeListRowMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTreeListRowMethod "getChildRow" o = TreeListRowGetChildRowMethodInfo
    ResolveTreeListRowMethod "getChildren" o = TreeListRowGetChildrenMethodInfo
    ResolveTreeListRowMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTreeListRowMethod "getDepth" o = TreeListRowGetDepthMethodInfo
    ResolveTreeListRowMethod "getExpanded" o = TreeListRowGetExpandedMethodInfo
    ResolveTreeListRowMethod "getItem" o = TreeListRowGetItemMethodInfo
    ResolveTreeListRowMethod "getParent" o = TreeListRowGetParentMethodInfo
    ResolveTreeListRowMethod "getPosition" o = TreeListRowGetPositionMethodInfo
    ResolveTreeListRowMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTreeListRowMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTreeListRowMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTreeListRowMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTreeListRowMethod "setExpanded" o = TreeListRowSetExpandedMethodInfo
    ResolveTreeListRowMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTreeListRowMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTreeListRowMethod t TreeListRow, O.MethodInfo info TreeListRow p) => OL.IsLabel t (TreeListRow -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

-- | Get the value of the “@children@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' treeListRow #children
-- @
getTreeListRowChildren :: (MonadIO m, IsTreeListRow o) => o -> m (Maybe Gio.ListModel.ListModel)
getTreeListRowChildren :: o -> m (Maybe ListModel)
getTreeListRowChildren o
obj = IO (Maybe ListModel) -> m (Maybe ListModel)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe 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
"children" ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel

#if defined(ENABLE_OVERLOADING)
data TreeListRowChildrenPropertyInfo
instance AttrInfo TreeListRowChildrenPropertyInfo where
    type AttrAllowedOps TreeListRowChildrenPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TreeListRowChildrenPropertyInfo = IsTreeListRow
    type AttrSetTypeConstraint TreeListRowChildrenPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TreeListRowChildrenPropertyInfo = (~) ()
    type AttrTransferType TreeListRowChildrenPropertyInfo = ()
    type AttrGetType TreeListRowChildrenPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel TreeListRowChildrenPropertyInfo = "children"
    type AttrOrigin TreeListRowChildrenPropertyInfo = TreeListRow
    attrGet = getTreeListRowChildren
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "depth"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data TreeListRowDepthPropertyInfo
instance AttrInfo TreeListRowDepthPropertyInfo where
    type AttrAllowedOps TreeListRowDepthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TreeListRowDepthPropertyInfo = IsTreeListRow
    type AttrSetTypeConstraint TreeListRowDepthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TreeListRowDepthPropertyInfo = (~) ()
    type AttrTransferType TreeListRowDepthPropertyInfo = ()
    type AttrGetType TreeListRowDepthPropertyInfo = Word32
    type AttrLabel TreeListRowDepthPropertyInfo = "depth"
    type AttrOrigin TreeListRowDepthPropertyInfo = TreeListRow
    attrGet = getTreeListRowDepth
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "expandable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@expandable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' treeListRow #expandable
-- @
getTreeListRowExpandable :: (MonadIO m, IsTreeListRow o) => o -> m Bool
getTreeListRowExpandable :: o -> m Bool
getTreeListRowExpandable 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 String
"expandable"

#if defined(ENABLE_OVERLOADING)
data TreeListRowExpandablePropertyInfo
instance AttrInfo TreeListRowExpandablePropertyInfo where
    type AttrAllowedOps TreeListRowExpandablePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TreeListRowExpandablePropertyInfo = IsTreeListRow
    type AttrSetTypeConstraint TreeListRowExpandablePropertyInfo = (~) ()
    type AttrTransferTypeConstraint TreeListRowExpandablePropertyInfo = (~) ()
    type AttrTransferType TreeListRowExpandablePropertyInfo = ()
    type AttrGetType TreeListRowExpandablePropertyInfo = Bool
    type AttrLabel TreeListRowExpandablePropertyInfo = "expandable"
    type AttrOrigin TreeListRowExpandablePropertyInfo = TreeListRow
    attrGet = getTreeListRowExpandable
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | Get the value of the “@expanded@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' treeListRow #expanded
-- @
getTreeListRowExpanded :: (MonadIO m, IsTreeListRow o) => o -> m Bool
getTreeListRowExpanded :: o -> m Bool
getTreeListRowExpanded 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 String
"expanded"

-- | Set the value of the “@expanded@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' treeListRow [ #expanded 'Data.GI.Base.Attributes.:=' value ]
-- @
setTreeListRowExpanded :: (MonadIO m, IsTreeListRow o) => o -> Bool -> m ()
setTreeListRowExpanded :: o -> Bool -> m ()
setTreeListRowExpanded o
obj 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 String
"expanded" Bool
val

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

#if defined(ENABLE_OVERLOADING)
data TreeListRowExpandedPropertyInfo
instance AttrInfo TreeListRowExpandedPropertyInfo where
    type AttrAllowedOps TreeListRowExpandedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TreeListRowExpandedPropertyInfo = IsTreeListRow
    type AttrSetTypeConstraint TreeListRowExpandedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TreeListRowExpandedPropertyInfo = (~) Bool
    type AttrTransferType TreeListRowExpandedPropertyInfo = Bool
    type AttrGetType TreeListRowExpandedPropertyInfo = Bool
    type AttrLabel TreeListRowExpandedPropertyInfo = "expanded"
    type AttrOrigin TreeListRowExpandedPropertyInfo = TreeListRow
    attrGet = getTreeListRowExpanded
    attrSet = setTreeListRowExpanded
    attrTransfer _ v = do
        return v
    attrConstruct = constructTreeListRowExpanded
    attrClear = undefined
#endif

-- VVV Prop "item"
   -- Type: TInterface (Name {namespace = "GObject", name = "Object"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@item@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' treeListRow #item
-- @
getTreeListRowItem :: (MonadIO m, IsTreeListRow o) => o -> m (Maybe GObject.Object.Object)
getTreeListRowItem :: o -> m (Maybe Object)
getTreeListRowItem o
obj = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Object -> Object) -> IO (Maybe Object)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"item" ManagedPtr Object -> Object
GObject.Object.Object

#if defined(ENABLE_OVERLOADING)
data TreeListRowItemPropertyInfo
instance AttrInfo TreeListRowItemPropertyInfo where
    type AttrAllowedOps TreeListRowItemPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TreeListRowItemPropertyInfo = IsTreeListRow
    type AttrSetTypeConstraint TreeListRowItemPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TreeListRowItemPropertyInfo = (~) ()
    type AttrTransferType TreeListRowItemPropertyInfo = ()
    type AttrGetType TreeListRowItemPropertyInfo = (Maybe GObject.Object.Object)
    type AttrLabel TreeListRowItemPropertyInfo = "item"
    type AttrOrigin TreeListRowItemPropertyInfo = TreeListRow
    attrGet = getTreeListRowItem
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TreeListRow
type instance O.AttributeList TreeListRow = TreeListRowAttributeList
type TreeListRowAttributeList = ('[ '("children", TreeListRowChildrenPropertyInfo), '("depth", TreeListRowDepthPropertyInfo), '("expandable", TreeListRowExpandablePropertyInfo), '("expanded", TreeListRowExpandedPropertyInfo), '("item", TreeListRowItemPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
treeListRowChildren :: AttrLabelProxy "children"
treeListRowChildren = AttrLabelProxy

treeListRowDepth :: AttrLabelProxy "depth"
treeListRowDepth = AttrLabelProxy

treeListRowExpandable :: AttrLabelProxy "expandable"
treeListRowExpandable = AttrLabelProxy

treeListRowExpanded :: AttrLabelProxy "expanded"
treeListRowExpanded = AttrLabelProxy

treeListRowItem :: AttrLabelProxy "item"
treeListRowItem = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TreeListRow = TreeListRowSignalList
type TreeListRowSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method TreeListRow::get_child_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , 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_row_get_child_row" gtk_tree_list_row_get_child_row :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    Word32 ->                               -- position : TBasicType TUInt
    IO (Ptr TreeListRow)

-- | If /@self@/ is not expanded or /@position@/ is greater than the number of
-- children, 'P.Nothing' is returned.
treeListRowGetChildRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> Word32
    -- ^ /@position@/: position of the child to get
    -> m (Maybe TreeListRow)
    -- ^ __Returns:__ the child in /@position@/
treeListRowGetChildRow :: a -> Word32 -> m (Maybe TreeListRow)
treeListRowGetChildRow 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 TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TreeListRow
result <- Ptr TreeListRow -> Word32 -> IO (Ptr TreeListRow)
gtk_tree_list_row_get_child_row Ptr TreeListRow
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
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 TreeListRowGetChildRowMethodInfo
instance (signature ~ (Word32 -> m (Maybe TreeListRow)), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetChildRowMethodInfo a signature where
    overloadedMethod = treeListRowGetChildRow

#endif

-- method TreeListRow::get_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , 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_row_get_children" gtk_tree_list_row_get_children :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO (Ptr Gio.ListModel.ListModel)

-- | If the row is expanded, gets the model holding the children of /@self@/.
-- 
-- This model is the model created by the t'GI.Gtk.Callbacks.TreeListModelCreateModelFunc'
-- and contains the original items, no matter what value
-- t'GI.Gtk.Objects.TreeListModel.TreeListModel':@/passthrough/@ is set to.
treeListRowGetChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model containing the children
treeListRowGetChildren :: a -> m (Maybe ListModel)
treeListRowGetChildren a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr TreeListRow -> IO (Ptr ListModel)
gtk_tree_list_row_get_children Ptr TreeListRow
self'
    Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
        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'
        ListModel -> IO ListModel
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ListModel -> IO (Maybe ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data TreeListRowGetChildrenMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetChildrenMethodInfo a signature where
    overloadedMethod = treeListRowGetChildren

#endif

-- method TreeListRow::get_depth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_list_row_get_depth" gtk_tree_list_row_get_depth :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO Word32

-- | Gets the depth of this row. Rows that correspond to items in
-- the root model have a depth of zero, rows corresponding to items
-- of models of direct children of the root model have a depth of
-- 1 and so on.
-- 
-- The depth of a row never changes until the row is destroyed.
treeListRowGetDepth ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m Word32
    -- ^ __Returns:__ The depth of this row
treeListRowGetDepth :: a -> m Word32
treeListRowGetDepth a
self = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr TreeListRow -> IO Word32
gtk_tree_list_row_get_depth Ptr TreeListRow
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TreeListRowGetDepthMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetDepthMethodInfo a signature where
    overloadedMethod = treeListRowGetDepth

#endif

-- method TreeListRow::get_expanded
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , 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_row_get_expanded" gtk_tree_list_row_get_expanded :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO CInt

-- | Gets if a row is currently expanded.
treeListRowGetExpanded ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the row is expanded
treeListRowGetExpanded :: a -> m Bool
treeListRowGetExpanded 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 TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TreeListRow -> IO CInt
gtk_tree_list_row_get_expanded Ptr TreeListRow
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 TreeListRowGetExpandedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetExpandedMethodInfo a signature where
    overloadedMethod = treeListRowGetExpanded

#endif

-- method TreeListRow::get_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_list_row_get_item" gtk_tree_list_row_get_item :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO (Ptr GObject.Object.Object)

-- | Gets the item corresponding to this row,
-- 
-- The value returned by this function never changes until the
-- row is destroyed.
treeListRowGetItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m (Maybe GObject.Object.Object)
    -- ^ __Returns:__ The item of this row
    --    or 'P.Nothing' when the row was destroyed
treeListRowGetItem :: a -> m (Maybe Object)
treeListRowGetItem a
self = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
result <- Ptr TreeListRow -> IO (Ptr Object)
gtk_tree_list_row_get_item Ptr TreeListRow
self'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data TreeListRowGetItemMethodInfo
instance (signature ~ (m (Maybe GObject.Object.Object)), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetItemMethodInfo a signature where
    overloadedMethod = treeListRowGetItem

#endif

-- method TreeListRow::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , 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_row_get_parent" gtk_tree_list_row_get_parent :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO (Ptr TreeListRow)

-- | Gets the row representing the parent for /@self@/. That is the row that would
-- need to be collapsed to make this row disappear.
-- 
-- If /@self@/ is a row corresponding to the root model, 'P.Nothing' is returned.
-- 
-- The value returned by this function never changes until the
-- row is destroyed.
treeListRowGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m (Maybe TreeListRow)
    -- ^ __Returns:__ The parent of /@self@/
treeListRowGetParent :: a -> m (Maybe TreeListRow)
treeListRowGetParent a
self = 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 TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TreeListRow
result <- Ptr TreeListRow -> IO (Ptr TreeListRow)
gtk_tree_list_row_get_parent Ptr TreeListRow
self'
    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
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 TreeListRowGetParentMethodInfo
instance (signature ~ (m (Maybe TreeListRow)), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetParentMethodInfo a signature where
    overloadedMethod = treeListRowGetParent

#endif

-- method TreeListRow::get_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_tree_list_row_get_position" gtk_tree_list_row_get_position :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO Word32

-- | Returns the position in the t'GI.Gtk.Objects.TreeListModel.TreeListModel' that /@self@/ occupies
-- at the moment.
treeListRowGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m Word32
    -- ^ __Returns:__ The position in the model
treeListRowGetPosition :: a -> m Word32
treeListRowGetPosition a
self = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr TreeListRow -> IO Word32
gtk_tree_list_row_get_position Ptr TreeListRow
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TreeListRowGetPositionMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowGetPositionMethodInfo a signature where
    overloadedMethod = treeListRowGetPosition

#endif

-- method TreeListRow::is_expandable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , 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_row_is_expandable" gtk_tree_list_row_is_expandable :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    IO CInt

-- | Checks if a row can be expanded. This does not mean that the
-- row is actually expanded, this can be checked with
-- 'GI.Gtk.Objects.TreeListRow.treeListRowGetExpanded'
-- 
-- If a row is expandable never changes until the row is destroyed.
treeListRowIsExpandable ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the row is expandable
treeListRowIsExpandable :: a -> m Bool
treeListRowIsExpandable 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 TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TreeListRow -> IO CInt
gtk_tree_list_row_is_expandable Ptr TreeListRow
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 TreeListRowIsExpandableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowIsExpandableMethodInfo a signature where
    overloadedMethod = treeListRowIsExpandable

#endif

-- method TreeListRow::set_expanded
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TreeListRow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTreeListRow" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expanded"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the row should be expanded"
--                 , 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_row_set_expanded" gtk_tree_list_row_set_expanded :: 
    Ptr TreeListRow ->                      -- self : TInterface (Name {namespace = "Gtk", name = "TreeListRow"})
    CInt ->                                 -- expanded : TBasicType TBoolean
    IO ()

-- | Expands or collapses a row.
-- 
-- If a row is expanded, the model of calling the
-- t'GI.Gtk.Callbacks.TreeListModelCreateModelFunc' for the row\'s item will
-- be inserted after this row. If a row is collapsed, those
-- items will be removed from the model.
-- 
-- If the row is not expandable, this function does nothing.
treeListRowSetExpanded ::
    (B.CallStack.HasCallStack, MonadIO m, IsTreeListRow a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.TreeListRow.TreeListRow'
    -> Bool
    -- ^ /@expanded@/: 'P.True' if the row should be expanded
    -> m ()
treeListRowSetExpanded :: a -> Bool -> m ()
treeListRowSetExpanded a
self Bool
expanded = 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 TreeListRow
self' <- a -> IO (Ptr TreeListRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let expanded' :: CInt
expanded' = (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
expanded
    Ptr TreeListRow -> CInt -> IO ()
gtk_tree_list_row_set_expanded Ptr TreeListRow
self' CInt
expanded'
    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 TreeListRowSetExpandedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTreeListRow a) => O.MethodInfo TreeListRowSetExpandedMethodInfo a signature where
    overloadedMethod = treeListRowSetExpanded

#endif