{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Dazzle.Objects.TreeNode
(
TreeNode(..) ,
IsTreeNode ,
toTreeNode ,
#if defined(ENABLE_OVERLOADING)
ResolveTreeNodeMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeAddEmblemMethodInfo ,
#endif
treeNodeAddEmblem ,
#if defined(ENABLE_OVERLOADING)
TreeNodeAppendMethodInfo ,
#endif
treeNodeAppend ,
#if defined(ENABLE_OVERLOADING)
TreeNodeClearEmblemsMethodInfo ,
#endif
treeNodeClearEmblems ,
#if defined(ENABLE_OVERLOADING)
TreeNodeCollapseMethodInfo ,
#endif
treeNodeCollapse ,
#if defined(ENABLE_OVERLOADING)
TreeNodeExpandMethodInfo ,
#endif
treeNodeExpand ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetAreaMethodInfo ,
#endif
treeNodeGetArea ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetChildrenPossibleMethodInfo ,
#endif
treeNodeGetChildrenPossible ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetExpandedMethodInfo ,
#endif
treeNodeGetExpanded ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetForegroundRgbaMethodInfo ,
#endif
treeNodeGetForegroundRgba ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetGiconMethodInfo ,
#endif
treeNodeGetGicon ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetIconNameMethodInfo ,
#endif
treeNodeGetIconName ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetItemMethodInfo ,
#endif
treeNodeGetItem ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetIterMethodInfo ,
#endif
treeNodeGetIter ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetParentMethodInfo ,
#endif
treeNodeGetParent ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetPathMethodInfo ,
#endif
treeNodeGetPath ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetResetOnCollapseMethodInfo ,
#endif
treeNodeGetResetOnCollapse ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetTextMethodInfo ,
#endif
treeNodeGetText ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetTreeMethodInfo ,
#endif
treeNodeGetTree ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetUseDimLabelMethodInfo ,
#endif
treeNodeGetUseDimLabel ,
#if defined(ENABLE_OVERLOADING)
TreeNodeGetUseMarkupMethodInfo ,
#endif
treeNodeGetUseMarkup ,
#if defined(ENABLE_OVERLOADING)
TreeNodeHasEmblemMethodInfo ,
#endif
treeNodeHasEmblem ,
#if defined(ENABLE_OVERLOADING)
TreeNodeInsertMethodInfo ,
#endif
treeNodeInsert ,
#if defined(ENABLE_OVERLOADING)
TreeNodeInsertSortedMethodInfo ,
#endif
treeNodeInsertSorted ,
#if defined(ENABLE_OVERLOADING)
TreeNodeInvalidateMethodInfo ,
#endif
treeNodeInvalidate ,
#if defined(ENABLE_OVERLOADING)
TreeNodeIsRootMethodInfo ,
#endif
treeNodeIsRoot ,
#if defined(ENABLE_OVERLOADING)
TreeNodeNChildrenMethodInfo ,
#endif
treeNodeNChildren ,
treeNodeNew ,
#if defined(ENABLE_OVERLOADING)
TreeNodeNthChildMethodInfo ,
#endif
treeNodeNthChild ,
#if defined(ENABLE_OVERLOADING)
TreeNodePrependMethodInfo ,
#endif
treeNodePrepend ,
#if defined(ENABLE_OVERLOADING)
TreeNodeRebuildMethodInfo ,
#endif
treeNodeRebuild ,
#if defined(ENABLE_OVERLOADING)
TreeNodeRemoveMethodInfo ,
#endif
treeNodeRemove ,
#if defined(ENABLE_OVERLOADING)
TreeNodeRemoveEmblemMethodInfo ,
#endif
treeNodeRemoveEmblem ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSelectMethodInfo ,
#endif
treeNodeSelect ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetChildrenPossibleMethodInfo ,
#endif
treeNodeSetChildrenPossible ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetEmblemsMethodInfo ,
#endif
treeNodeSetEmblems ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetForegroundRgbaMethodInfo ,
#endif
treeNodeSetForegroundRgba ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetGiconMethodInfo ,
#endif
treeNodeSetGicon ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetIconNameMethodInfo ,
#endif
treeNodeSetIconName ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetItemMethodInfo ,
#endif
treeNodeSetItem ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetResetOnCollapseMethodInfo ,
#endif
treeNodeSetResetOnCollapse ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetTextMethodInfo ,
#endif
treeNodeSetText ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetUseDimLabelMethodInfo ,
#endif
treeNodeSetUseDimLabel ,
#if defined(ENABLE_OVERLOADING)
TreeNodeSetUseMarkupMethodInfo ,
#endif
treeNodeSetUseMarkup ,
#if defined(ENABLE_OVERLOADING)
TreeNodeShowPopoverMethodInfo ,
#endif
treeNodeShowPopover ,
#if defined(ENABLE_OVERLOADING)
TreeNodeChildrenPossiblePropertyInfo ,
#endif
constructTreeNodeChildrenPossible ,
getTreeNodeChildrenPossible ,
setTreeNodeChildrenPossible ,
#if defined(ENABLE_OVERLOADING)
treeNodeChildrenPossible ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeExpandedIconNamePropertyInfo ,
#endif
clearTreeNodeExpandedIconName ,
constructTreeNodeExpandedIconName ,
getTreeNodeExpandedIconName ,
setTreeNodeExpandedIconName ,
#if defined(ENABLE_OVERLOADING)
treeNodeExpandedIconName ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeGiconPropertyInfo ,
#endif
constructTreeNodeGicon ,
getTreeNodeGicon ,
setTreeNodeGicon ,
#if defined(ENABLE_OVERLOADING)
treeNodeGicon ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeIconNamePropertyInfo ,
#endif
clearTreeNodeIconName ,
constructTreeNodeIconName ,
getTreeNodeIconName ,
setTreeNodeIconName ,
#if defined(ENABLE_OVERLOADING)
treeNodeIconName ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeItemPropertyInfo ,
#endif
constructTreeNodeItem ,
getTreeNodeItem ,
setTreeNodeItem ,
#if defined(ENABLE_OVERLOADING)
treeNodeItem ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeParentPropertyInfo ,
#endif
getTreeNodeParent ,
#if defined(ENABLE_OVERLOADING)
treeNodeParent ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeResetOnCollapsePropertyInfo ,
#endif
constructTreeNodeResetOnCollapse ,
getTreeNodeResetOnCollapse ,
setTreeNodeResetOnCollapse ,
#if defined(ENABLE_OVERLOADING)
treeNodeResetOnCollapse ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeTextPropertyInfo ,
#endif
clearTreeNodeText ,
constructTreeNodeText ,
getTreeNodeText ,
setTreeNodeText ,
#if defined(ENABLE_OVERLOADING)
treeNodeText ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeTreePropertyInfo ,
#endif
clearTreeNodeTree ,
constructTreeNodeTree ,
getTreeNodeTree ,
setTreeNodeTree ,
#if defined(ENABLE_OVERLOADING)
treeNodeTree ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeUseDimLabelPropertyInfo ,
#endif
constructTreeNodeUseDimLabel ,
getTreeNodeUseDimLabel ,
setTreeNodeUseDimLabel ,
#if defined(ENABLE_OVERLOADING)
treeNodeUseDimLabel ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeNodeUseMarkupPropertyInfo ,
#endif
constructTreeNodeUseMarkup ,
getTreeNodeUseMarkup ,
setTreeNodeUseMarkup ,
#if defined(ENABLE_OVERLOADING)
treeNodeUseMarkup ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Objects.Tree as Dazzle.Tree
import {-# SOURCE #-} qualified GI.Dazzle.Objects.TreeBuilder as Dazzle.TreeBuilder
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.Scrollable as Gtk.Scrollable
import qualified GI.Gtk.Objects.Container as Gtk.Container
import qualified GI.Gtk.Objects.Popover as Gtk.Popover
import qualified GI.Gtk.Objects.TreeView as Gtk.TreeView
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Gtk.Structs.SelectionData as Gtk.SelectionData
import qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter
import qualified GI.Gtk.Structs.TreePath as Gtk.TreePath
#else
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import {-# SOURCE #-} qualified GI.Dazzle.Objects.Tree as Dazzle.Tree
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Objects.Popover as Gtk.Popover
import qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter
import qualified GI.Gtk.Structs.TreePath as Gtk.TreePath
#endif
newtype TreeNode = TreeNode (SP.ManagedPtr TreeNode)
deriving (TreeNode -> TreeNode -> Bool
(TreeNode -> TreeNode -> Bool)
-> (TreeNode -> TreeNode -> Bool) -> Eq TreeNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TreeNode -> TreeNode -> Bool
== :: TreeNode -> TreeNode -> Bool
$c/= :: TreeNode -> TreeNode -> Bool
/= :: TreeNode -> TreeNode -> Bool
Eq)
instance SP.ManagedPtrNewtype TreeNode where
toManagedPtr :: TreeNode -> ManagedPtr TreeNode
toManagedPtr (TreeNode ManagedPtr TreeNode
p) = ManagedPtr TreeNode
p
foreign import ccall "dzl_tree_node_get_type"
c_dzl_tree_node_get_type :: IO B.Types.GType
instance B.Types.TypedObject TreeNode where
glibType :: IO GType
glibType = IO GType
c_dzl_tree_node_get_type
instance B.Types.GObject TreeNode
class (SP.GObject o, O.IsDescendantOf TreeNode o) => IsTreeNode o
instance (SP.GObject o, O.IsDescendantOf TreeNode o) => IsTreeNode o
instance O.HasParentTypes TreeNode
type instance O.ParentTypes TreeNode = '[GObject.Object.Object]
toTreeNode :: (MIO.MonadIO m, IsTreeNode o) => o -> m TreeNode
toTreeNode :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> m TreeNode
toTreeNode = IO TreeNode -> m TreeNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO TreeNode -> m TreeNode)
-> (o -> IO TreeNode) -> o -> m TreeNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr TreeNode -> TreeNode) -> o -> IO TreeNode
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr TreeNode -> TreeNode
TreeNode
instance B.GValue.IsGValue (Maybe TreeNode) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_tree_node_get_type
gvalueSet_ :: Ptr GValue -> Maybe TreeNode -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TreeNode
P.Nothing = Ptr GValue -> Ptr TreeNode -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr TreeNode
forall a. Ptr a
FP.nullPtr :: FP.Ptr TreeNode)
gvalueSet_ Ptr GValue
gv (P.Just TreeNode
obj) = TreeNode -> (Ptr TreeNode -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TreeNode
obj (Ptr GValue -> Ptr TreeNode -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe TreeNode)
gvalueGet_ Ptr GValue
gv = do
Ptr TreeNode
ptr <- Ptr GValue -> IO (Ptr TreeNode)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr TreeNode)
if Ptr TreeNode
ptr Ptr TreeNode -> Ptr TreeNode -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TreeNode
forall a. Ptr a
FP.nullPtr
then TreeNode -> Maybe TreeNode
forall a. a -> Maybe a
P.Just (TreeNode -> Maybe TreeNode) -> IO TreeNode -> IO (Maybe TreeNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr TreeNode -> TreeNode) -> Ptr TreeNode -> IO TreeNode
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr TreeNode -> TreeNode
TreeNode Ptr TreeNode
ptr
else Maybe TreeNode -> IO (Maybe TreeNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeNode
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveTreeNodeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveTreeNodeMethod "addEmblem" o = TreeNodeAddEmblemMethodInfo
ResolveTreeNodeMethod "append" o = TreeNodeAppendMethodInfo
ResolveTreeNodeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveTreeNodeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveTreeNodeMethod "clearEmblems" o = TreeNodeClearEmblemsMethodInfo
ResolveTreeNodeMethod "collapse" o = TreeNodeCollapseMethodInfo
ResolveTreeNodeMethod "expand" o = TreeNodeExpandMethodInfo
ResolveTreeNodeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveTreeNodeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveTreeNodeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveTreeNodeMethod "hasEmblem" o = TreeNodeHasEmblemMethodInfo
ResolveTreeNodeMethod "insert" o = TreeNodeInsertMethodInfo
ResolveTreeNodeMethod "insertSorted" o = TreeNodeInsertSortedMethodInfo
ResolveTreeNodeMethod "invalidate" o = TreeNodeInvalidateMethodInfo
ResolveTreeNodeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveTreeNodeMethod "isRoot" o = TreeNodeIsRootMethodInfo
ResolveTreeNodeMethod "nChildren" o = TreeNodeNChildrenMethodInfo
ResolveTreeNodeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveTreeNodeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveTreeNodeMethod "nthChild" o = TreeNodeNthChildMethodInfo
ResolveTreeNodeMethod "prepend" o = TreeNodePrependMethodInfo
ResolveTreeNodeMethod "rebuild" o = TreeNodeRebuildMethodInfo
ResolveTreeNodeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveTreeNodeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveTreeNodeMethod "remove" o = TreeNodeRemoveMethodInfo
ResolveTreeNodeMethod "removeEmblem" o = TreeNodeRemoveEmblemMethodInfo
ResolveTreeNodeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveTreeNodeMethod "select" o = TreeNodeSelectMethodInfo
ResolveTreeNodeMethod "showPopover" o = TreeNodeShowPopoverMethodInfo
ResolveTreeNodeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveTreeNodeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveTreeNodeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveTreeNodeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveTreeNodeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveTreeNodeMethod "getArea" o = TreeNodeGetAreaMethodInfo
ResolveTreeNodeMethod "getChildrenPossible" o = TreeNodeGetChildrenPossibleMethodInfo
ResolveTreeNodeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveTreeNodeMethod "getExpanded" o = TreeNodeGetExpandedMethodInfo
ResolveTreeNodeMethod "getForegroundRgba" o = TreeNodeGetForegroundRgbaMethodInfo
ResolveTreeNodeMethod "getGicon" o = TreeNodeGetGiconMethodInfo
ResolveTreeNodeMethod "getIconName" o = TreeNodeGetIconNameMethodInfo
ResolveTreeNodeMethod "getItem" o = TreeNodeGetItemMethodInfo
ResolveTreeNodeMethod "getIter" o = TreeNodeGetIterMethodInfo
ResolveTreeNodeMethod "getParent" o = TreeNodeGetParentMethodInfo
ResolveTreeNodeMethod "getPath" o = TreeNodeGetPathMethodInfo
ResolveTreeNodeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveTreeNodeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveTreeNodeMethod "getResetOnCollapse" o = TreeNodeGetResetOnCollapseMethodInfo
ResolveTreeNodeMethod "getText" o = TreeNodeGetTextMethodInfo
ResolveTreeNodeMethod "getTree" o = TreeNodeGetTreeMethodInfo
ResolveTreeNodeMethod "getUseDimLabel" o = TreeNodeGetUseDimLabelMethodInfo
ResolveTreeNodeMethod "getUseMarkup" o = TreeNodeGetUseMarkupMethodInfo
ResolveTreeNodeMethod "setChildrenPossible" o = TreeNodeSetChildrenPossibleMethodInfo
ResolveTreeNodeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveTreeNodeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveTreeNodeMethod "setEmblems" o = TreeNodeSetEmblemsMethodInfo
ResolveTreeNodeMethod "setForegroundRgba" o = TreeNodeSetForegroundRgbaMethodInfo
ResolveTreeNodeMethod "setGicon" o = TreeNodeSetGiconMethodInfo
ResolveTreeNodeMethod "setIconName" o = TreeNodeSetIconNameMethodInfo
ResolveTreeNodeMethod "setItem" o = TreeNodeSetItemMethodInfo
ResolveTreeNodeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveTreeNodeMethod "setResetOnCollapse" o = TreeNodeSetResetOnCollapseMethodInfo
ResolveTreeNodeMethod "setText" o = TreeNodeSetTextMethodInfo
ResolveTreeNodeMethod "setUseDimLabel" o = TreeNodeSetUseDimLabelMethodInfo
ResolveTreeNodeMethod "setUseMarkup" o = TreeNodeSetUseMarkupMethodInfo
ResolveTreeNodeMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveTreeNodeMethod t TreeNode, O.OverloadedMethod info TreeNode p) => OL.IsLabel t (TreeNode -> 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 ~ ResolveTreeNodeMethod t TreeNode, O.OverloadedMethod info TreeNode p, R.HasField t TreeNode p) => R.HasField t TreeNode p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveTreeNodeMethod t TreeNode, O.OverloadedMethodInfo info TreeNode) => OL.IsLabel t (O.MethodProxy info TreeNode) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getTreeNodeChildrenPossible :: (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeChildrenPossible :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeChildrenPossible o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"children-possible"
setTreeNodeChildrenPossible :: (MonadIO m, IsTreeNode o) => o -> Bool -> m ()
setTreeNodeChildrenPossible :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Bool -> m ()
setTreeNodeChildrenPossible o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"children-possible" Bool
val
constructTreeNodeChildrenPossible :: (IsTreeNode o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTreeNodeChildrenPossible :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTreeNodeChildrenPossible Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"children-possible" Bool
val
#if defined(ENABLE_OVERLOADING)
data TreeNodeChildrenPossiblePropertyInfo
instance AttrInfo TreeNodeChildrenPossiblePropertyInfo where
type AttrAllowedOps TreeNodeChildrenPossiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeNodeChildrenPossiblePropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeChildrenPossiblePropertyInfo = (~) Bool
type AttrTransferTypeConstraint TreeNodeChildrenPossiblePropertyInfo = (~) Bool
type AttrTransferType TreeNodeChildrenPossiblePropertyInfo = Bool
type AttrGetType TreeNodeChildrenPossiblePropertyInfo = Bool
type AttrLabel TreeNodeChildrenPossiblePropertyInfo = "children-possible"
type AttrOrigin TreeNodeChildrenPossiblePropertyInfo = TreeNode
attrGet = getTreeNodeChildrenPossible
attrSet = setTreeNodeChildrenPossible
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeChildrenPossible
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.childrenPossible"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:childrenPossible"
})
#endif
getTreeNodeExpandedIconName :: (MonadIO m, IsTreeNode o) => o -> m (Maybe T.Text)
getTreeNodeExpandedIconName :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> m (Maybe Text)
getTreeNodeExpandedIconName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"expanded-icon-name"
setTreeNodeExpandedIconName :: (MonadIO m, IsTreeNode o) => o -> T.Text -> m ()
setTreeNodeExpandedIconName :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Text -> m ()
setTreeNodeExpandedIconName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"expanded-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructTreeNodeExpandedIconName :: (IsTreeNode o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTreeNodeExpandedIconName :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructTreeNodeExpandedIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"expanded-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearTreeNodeExpandedIconName :: (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeExpandedIconName :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeExpandedIconName o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"expanded-icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data TreeNodeExpandedIconNamePropertyInfo
instance AttrInfo TreeNodeExpandedIconNamePropertyInfo where
type AttrAllowedOps TreeNodeExpandedIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint TreeNodeExpandedIconNamePropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeExpandedIconNamePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint TreeNodeExpandedIconNamePropertyInfo = (~) T.Text
type AttrTransferType TreeNodeExpandedIconNamePropertyInfo = T.Text
type AttrGetType TreeNodeExpandedIconNamePropertyInfo = (Maybe T.Text)
type AttrLabel TreeNodeExpandedIconNamePropertyInfo = "expanded-icon-name"
type AttrOrigin TreeNodeExpandedIconNamePropertyInfo = TreeNode
attrGet = getTreeNodeExpandedIconName
attrSet = setTreeNodeExpandedIconName
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeExpandedIconName
attrClear = clearTreeNodeExpandedIconName
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.expandedIconName"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:expandedIconName"
})
#endif
getTreeNodeGicon :: (MonadIO m, IsTreeNode o) => o -> m Gio.Icon.Icon
getTreeNodeGicon :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Icon
getTreeNodeGicon o
obj = IO Icon -> m Icon
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Icon) -> IO Icon
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTreeNodeGicon" (IO (Maybe Icon) -> IO Icon) -> IO (Maybe Icon) -> IO Icon
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Icon -> Icon) -> IO (Maybe Icon)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"gicon" ManagedPtr Icon -> Icon
Gio.Icon.Icon
setTreeNodeGicon :: (MonadIO m, IsTreeNode o, Gio.Icon.IsIcon a) => o -> a -> m ()
setTreeNodeGicon :: forall (m :: * -> *) o a.
(MonadIO m, IsTreeNode o, IsIcon a) =>
o -> a -> m ()
setTreeNodeGicon o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"gicon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructTreeNodeGicon :: (IsTreeNode o, MIO.MonadIO m, Gio.Icon.IsIcon a) => a -> m (GValueConstruct o)
constructTreeNodeGicon :: forall o (m :: * -> *) a.
(IsTreeNode o, MonadIO m, IsIcon a) =>
a -> m (GValueConstruct o)
constructTreeNodeGicon a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"gicon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data TreeNodeGiconPropertyInfo
instance AttrInfo TreeNodeGiconPropertyInfo where
type AttrAllowedOps TreeNodeGiconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeNodeGiconPropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeGiconPropertyInfo = Gio.Icon.IsIcon
type AttrTransferTypeConstraint TreeNodeGiconPropertyInfo = Gio.Icon.IsIcon
type AttrTransferType TreeNodeGiconPropertyInfo = Gio.Icon.Icon
type AttrGetType TreeNodeGiconPropertyInfo = Gio.Icon.Icon
type AttrLabel TreeNodeGiconPropertyInfo = "gicon"
type AttrOrigin TreeNodeGiconPropertyInfo = TreeNode
attrGet = getTreeNodeGicon
attrSet = setTreeNodeGicon
attrTransfer _ v = do
unsafeCastTo Gio.Icon.Icon v
attrConstruct = constructTreeNodeGicon
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.gicon"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:gicon"
})
#endif
getTreeNodeIconName :: (MonadIO m, IsTreeNode o) => o -> m T.Text
getTreeNodeIconName :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Text
getTreeNodeIconName o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTreeNodeIconName" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"icon-name"
setTreeNodeIconName :: (MonadIO m, IsTreeNode o) => o -> T.Text -> m ()
setTreeNodeIconName :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Text -> m ()
setTreeNodeIconName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructTreeNodeIconName :: (IsTreeNode o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTreeNodeIconName :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructTreeNodeIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearTreeNodeIconName :: (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeIconName :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeIconName o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data TreeNodeIconNamePropertyInfo
instance AttrInfo TreeNodeIconNamePropertyInfo where
type AttrAllowedOps TreeNodeIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint TreeNodeIconNamePropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeIconNamePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint TreeNodeIconNamePropertyInfo = (~) T.Text
type AttrTransferType TreeNodeIconNamePropertyInfo = T.Text
type AttrGetType TreeNodeIconNamePropertyInfo = T.Text
type AttrLabel TreeNodeIconNamePropertyInfo = "icon-name"
type AttrOrigin TreeNodeIconNamePropertyInfo = TreeNode
attrGet = getTreeNodeIconName
attrSet = setTreeNodeIconName
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeIconName
attrClear = clearTreeNodeIconName
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.iconName"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:iconName"
})
#endif
getTreeNodeItem :: (MonadIO m, IsTreeNode o) => o -> m GObject.Object.Object
getTreeNodeItem :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Object
getTreeNodeItem o
obj = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Object) -> IO Object
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTreeNodeItem" (IO (Maybe Object) -> IO Object) -> IO (Maybe Object) -> IO 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
setTreeNodeItem :: (MonadIO m, IsTreeNode o, GObject.Object.IsObject a) => o -> a -> m ()
setTreeNodeItem :: forall (m :: * -> *) o a.
(MonadIO m, IsTreeNode o, IsObject a) =>
o -> a -> m ()
setTreeNodeItem o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"item" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructTreeNodeItem :: (IsTreeNode o, MIO.MonadIO m, GObject.Object.IsObject a) => a -> m (GValueConstruct o)
constructTreeNodeItem :: forall o (m :: * -> *) a.
(IsTreeNode o, MonadIO m, IsObject a) =>
a -> m (GValueConstruct o)
constructTreeNodeItem a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"item" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data TreeNodeItemPropertyInfo
instance AttrInfo TreeNodeItemPropertyInfo where
type AttrAllowedOps TreeNodeItemPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeNodeItemPropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeItemPropertyInfo = GObject.Object.IsObject
type AttrTransferTypeConstraint TreeNodeItemPropertyInfo = GObject.Object.IsObject
type AttrTransferType TreeNodeItemPropertyInfo = GObject.Object.Object
type AttrGetType TreeNodeItemPropertyInfo = GObject.Object.Object
type AttrLabel TreeNodeItemPropertyInfo = "item"
type AttrOrigin TreeNodeItemPropertyInfo = TreeNode
attrGet = getTreeNodeItem
attrSet = setTreeNodeItem
attrTransfer _ v = do
unsafeCastTo GObject.Object.Object v
attrConstruct = constructTreeNodeItem
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.item"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:item"
})
#endif
getTreeNodeParent :: (MonadIO m, IsTreeNode o) => o -> m TreeNode
getTreeNodeParent :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> m TreeNode
getTreeNodeParent o
obj = IO TreeNode -> m TreeNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO TreeNode -> m TreeNode) -> IO TreeNode -> m TreeNode
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe TreeNode) -> IO TreeNode
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTreeNodeParent" (IO (Maybe TreeNode) -> IO TreeNode)
-> IO (Maybe TreeNode) -> IO TreeNode
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TreeNode -> TreeNode)
-> IO (Maybe TreeNode)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"parent" ManagedPtr TreeNode -> TreeNode
TreeNode
#if defined(ENABLE_OVERLOADING)
data TreeNodeParentPropertyInfo
instance AttrInfo TreeNodeParentPropertyInfo where
type AttrAllowedOps TreeNodeParentPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint TreeNodeParentPropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeParentPropertyInfo = (~) ()
type AttrTransferTypeConstraint TreeNodeParentPropertyInfo = (~) ()
type AttrTransferType TreeNodeParentPropertyInfo = ()
type AttrGetType TreeNodeParentPropertyInfo = TreeNode
type AttrLabel TreeNodeParentPropertyInfo = "parent"
type AttrOrigin TreeNodeParentPropertyInfo = TreeNode
attrGet = getTreeNodeParent
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.parent"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:parent"
})
#endif
getTreeNodeResetOnCollapse :: (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeResetOnCollapse :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeResetOnCollapse o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"reset-on-collapse"
setTreeNodeResetOnCollapse :: (MonadIO m, IsTreeNode o) => o -> Bool -> m ()
setTreeNodeResetOnCollapse :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Bool -> m ()
setTreeNodeResetOnCollapse o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"reset-on-collapse" Bool
val
constructTreeNodeResetOnCollapse :: (IsTreeNode o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTreeNodeResetOnCollapse :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTreeNodeResetOnCollapse Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"reset-on-collapse" Bool
val
#if defined(ENABLE_OVERLOADING)
data TreeNodeResetOnCollapsePropertyInfo
instance AttrInfo TreeNodeResetOnCollapsePropertyInfo where
type AttrAllowedOps TreeNodeResetOnCollapsePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeNodeResetOnCollapsePropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeResetOnCollapsePropertyInfo = (~) Bool
type AttrTransferTypeConstraint TreeNodeResetOnCollapsePropertyInfo = (~) Bool
type AttrTransferType TreeNodeResetOnCollapsePropertyInfo = Bool
type AttrGetType TreeNodeResetOnCollapsePropertyInfo = Bool
type AttrLabel TreeNodeResetOnCollapsePropertyInfo = "reset-on-collapse"
type AttrOrigin TreeNodeResetOnCollapsePropertyInfo = TreeNode
attrGet = getTreeNodeResetOnCollapse
attrSet = setTreeNodeResetOnCollapse
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeResetOnCollapse
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.resetOnCollapse"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:resetOnCollapse"
})
#endif
getTreeNodeText :: (MonadIO m, IsTreeNode o) => o -> m T.Text
getTreeNodeText :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Text
getTreeNodeText o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTreeNodeText" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"text"
setTreeNodeText :: (MonadIO m, IsTreeNode o) => o -> T.Text -> m ()
setTreeNodeText :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Text -> m ()
setTreeNodeText o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructTreeNodeText :: (IsTreeNode o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTreeNodeText :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructTreeNodeText Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearTreeNodeText :: (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeText :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeText o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data TreeNodeTextPropertyInfo
instance AttrInfo TreeNodeTextPropertyInfo where
type AttrAllowedOps TreeNodeTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint TreeNodeTextPropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeTextPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint TreeNodeTextPropertyInfo = (~) T.Text
type AttrTransferType TreeNodeTextPropertyInfo = T.Text
type AttrGetType TreeNodeTextPropertyInfo = T.Text
type AttrLabel TreeNodeTextPropertyInfo = "text"
type AttrOrigin TreeNodeTextPropertyInfo = TreeNode
attrGet = getTreeNodeText
attrSet = setTreeNodeText
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeText
attrClear = clearTreeNodeText
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.text"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:text"
})
#endif
getTreeNodeTree :: (MonadIO m, IsTreeNode o) => o -> m Dazzle.Tree.Tree
getTreeNodeTree :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Tree
getTreeNodeTree o
obj = IO Tree -> m Tree
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Tree -> m Tree) -> IO Tree -> m Tree
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Tree) -> IO Tree
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getTreeNodeTree" (IO (Maybe Tree) -> IO Tree) -> IO (Maybe Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Tree -> Tree) -> IO (Maybe Tree)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"tree" ManagedPtr Tree -> Tree
Dazzle.Tree.Tree
setTreeNodeTree :: (MonadIO m, IsTreeNode o, Dazzle.Tree.IsTree a) => o -> a -> m ()
setTreeNodeTree :: forall (m :: * -> *) o a.
(MonadIO m, IsTreeNode o, IsTree a) =>
o -> a -> m ()
setTreeNodeTree o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tree" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructTreeNodeTree :: (IsTreeNode o, MIO.MonadIO m, Dazzle.Tree.IsTree a) => a -> m (GValueConstruct o)
constructTreeNodeTree :: forall o (m :: * -> *) a.
(IsTreeNode o, MonadIO m, IsTree a) =>
a -> m (GValueConstruct o)
constructTreeNodeTree a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"tree" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
clearTreeNodeTree :: (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeTree :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m ()
clearTreeNodeTree o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Tree -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tree" (Maybe Tree
forall a. Maybe a
Nothing :: Maybe Dazzle.Tree.Tree)
#if defined(ENABLE_OVERLOADING)
data TreeNodeTreePropertyInfo
instance AttrInfo TreeNodeTreePropertyInfo where
type AttrAllowedOps TreeNodeTreePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint TreeNodeTreePropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeTreePropertyInfo = Dazzle.Tree.IsTree
type AttrTransferTypeConstraint TreeNodeTreePropertyInfo = Dazzle.Tree.IsTree
type AttrTransferType TreeNodeTreePropertyInfo = Dazzle.Tree.Tree
type AttrGetType TreeNodeTreePropertyInfo = Dazzle.Tree.Tree
type AttrLabel TreeNodeTreePropertyInfo = "tree"
type AttrOrigin TreeNodeTreePropertyInfo = TreeNode
attrGet = getTreeNodeTree
attrSet = setTreeNodeTree
attrTransfer _ v = do
unsafeCastTo Dazzle.Tree.Tree v
attrConstruct = constructTreeNodeTree
attrClear = clearTreeNodeTree
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.tree"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:tree"
})
#endif
getTreeNodeUseDimLabel :: (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeUseDimLabel :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeUseDimLabel o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"use-dim-label"
setTreeNodeUseDimLabel :: (MonadIO m, IsTreeNode o) => o -> Bool -> m ()
setTreeNodeUseDimLabel :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Bool -> m ()
setTreeNodeUseDimLabel o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"use-dim-label" Bool
val
constructTreeNodeUseDimLabel :: (IsTreeNode o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTreeNodeUseDimLabel :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTreeNodeUseDimLabel Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"use-dim-label" Bool
val
#if defined(ENABLE_OVERLOADING)
data TreeNodeUseDimLabelPropertyInfo
instance AttrInfo TreeNodeUseDimLabelPropertyInfo where
type AttrAllowedOps TreeNodeUseDimLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeNodeUseDimLabelPropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeUseDimLabelPropertyInfo = (~) Bool
type AttrTransferTypeConstraint TreeNodeUseDimLabelPropertyInfo = (~) Bool
type AttrTransferType TreeNodeUseDimLabelPropertyInfo = Bool
type AttrGetType TreeNodeUseDimLabelPropertyInfo = Bool
type AttrLabel TreeNodeUseDimLabelPropertyInfo = "use-dim-label"
type AttrOrigin TreeNodeUseDimLabelPropertyInfo = TreeNode
attrGet = getTreeNodeUseDimLabel
attrSet = setTreeNodeUseDimLabel
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeUseDimLabel
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.useDimLabel"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:useDimLabel"
})
#endif
getTreeNodeUseMarkup :: (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeUseMarkup :: forall (m :: * -> *) o. (MonadIO m, IsTreeNode o) => o -> m Bool
getTreeNodeUseMarkup o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"use-markup"
setTreeNodeUseMarkup :: (MonadIO m, IsTreeNode o) => o -> Bool -> m ()
setTreeNodeUseMarkup :: forall (m :: * -> *) o.
(MonadIO m, IsTreeNode o) =>
o -> Bool -> m ()
setTreeNodeUseMarkup o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"use-markup" Bool
val
constructTreeNodeUseMarkup :: (IsTreeNode o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTreeNodeUseMarkup :: forall o (m :: * -> *).
(IsTreeNode o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTreeNodeUseMarkup Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"use-markup" Bool
val
#if defined(ENABLE_OVERLOADING)
data TreeNodeUseMarkupPropertyInfo
instance AttrInfo TreeNodeUseMarkupPropertyInfo where
type AttrAllowedOps TreeNodeUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeNodeUseMarkupPropertyInfo = IsTreeNode
type AttrSetTypeConstraint TreeNodeUseMarkupPropertyInfo = (~) Bool
type AttrTransferTypeConstraint TreeNodeUseMarkupPropertyInfo = (~) Bool
type AttrTransferType TreeNodeUseMarkupPropertyInfo = Bool
type AttrGetType TreeNodeUseMarkupPropertyInfo = Bool
type AttrLabel TreeNodeUseMarkupPropertyInfo = "use-markup"
type AttrOrigin TreeNodeUseMarkupPropertyInfo = TreeNode
attrGet = getTreeNodeUseMarkup
attrSet = setTreeNodeUseMarkup
attrTransfer _ v = do
return v
attrConstruct = constructTreeNodeUseMarkup
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.useMarkup"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#g:attr:useMarkup"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TreeNode
type instance O.AttributeList TreeNode = TreeNodeAttributeList
type TreeNodeAttributeList = ('[ '("childrenPossible", TreeNodeChildrenPossiblePropertyInfo), '("expandedIconName", TreeNodeExpandedIconNamePropertyInfo), '("gicon", TreeNodeGiconPropertyInfo), '("iconName", TreeNodeIconNamePropertyInfo), '("item", TreeNodeItemPropertyInfo), '("parent", TreeNodeParentPropertyInfo), '("resetOnCollapse", TreeNodeResetOnCollapsePropertyInfo), '("text", TreeNodeTextPropertyInfo), '("tree", TreeNodeTreePropertyInfo), '("useDimLabel", TreeNodeUseDimLabelPropertyInfo), '("useMarkup", TreeNodeUseMarkupPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
treeNodeChildrenPossible :: AttrLabelProxy "childrenPossible"
treeNodeChildrenPossible = AttrLabelProxy
treeNodeExpandedIconName :: AttrLabelProxy "expandedIconName"
treeNodeExpandedIconName = AttrLabelProxy
treeNodeGicon :: AttrLabelProxy "gicon"
treeNodeGicon = AttrLabelProxy
treeNodeIconName :: AttrLabelProxy "iconName"
treeNodeIconName = AttrLabelProxy
treeNodeItem :: AttrLabelProxy "item"
treeNodeItem = AttrLabelProxy
treeNodeParent :: AttrLabelProxy "parent"
treeNodeParent = AttrLabelProxy
treeNodeResetOnCollapse :: AttrLabelProxy "resetOnCollapse"
treeNodeResetOnCollapse = AttrLabelProxy
treeNodeText :: AttrLabelProxy "text"
treeNodeText = AttrLabelProxy
treeNodeTree :: AttrLabelProxy "tree"
treeNodeTree = AttrLabelProxy
treeNodeUseDimLabel :: AttrLabelProxy "useDimLabel"
treeNodeUseDimLabel = AttrLabelProxy
treeNodeUseMarkup :: AttrLabelProxy "useMarkup"
treeNodeUseMarkup = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TreeNode = TreeNodeSignalList
type TreeNodeSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "dzl_tree_node_new" dzl_tree_node_new ::
IO (Ptr TreeNode)
treeNodeNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m TreeNode
treeNodeNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m TreeNode
treeNodeNew = IO TreeNode -> m TreeNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeNode -> m TreeNode) -> IO TreeNode -> m TreeNode
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
result <- IO (Ptr TreeNode)
dzl_tree_node_new
Text -> Ptr TreeNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeNew" Ptr TreeNode
result
TreeNode
result' <- ((ManagedPtr TreeNode -> TreeNode) -> Ptr TreeNode -> IO TreeNode
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TreeNode -> TreeNode
TreeNode) Ptr TreeNode
result
TreeNode -> IO TreeNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreeNode
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "dzl_tree_node_add_emblem" dzl_tree_node_add_emblem ::
Ptr TreeNode ->
CString ->
IO ()
treeNodeAddEmblem ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> T.Text
-> m ()
treeNodeAddEmblem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Text -> m ()
treeNodeAddEmblem a
self Text
emblemName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
emblemName' <- Text -> IO CString
textToCString Text
emblemName
Ptr TreeNode -> CString -> IO ()
dzl_tree_node_add_emblem Ptr TreeNode
self' CString
emblemName'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
emblemName'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeAddEmblemMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeAddEmblemMethodInfo a signature where
overloadedMethod = treeNodeAddEmblem
instance O.OverloadedMethodInfo TreeNodeAddEmblemMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeAddEmblem",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeAddEmblem"
})
#endif
foreign import ccall "dzl_tree_node_append" dzl_tree_node_append ::
Ptr TreeNode ->
Ptr TreeNode ->
IO ()
treeNodeAppend ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a
-> b
-> m ()
treeNodeAppend :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a -> b -> m ()
treeNodeAppend a
node b
child = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode
child' <- b -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
Ptr TreeNode -> Ptr TreeNode -> IO ()
dzl_tree_node_append Ptr TreeNode
node' Ptr TreeNode
child'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeAppendMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTreeNode a, IsTreeNode b) => O.OverloadedMethod TreeNodeAppendMethodInfo a signature where
overloadedMethod = treeNodeAppend
instance O.OverloadedMethodInfo TreeNodeAppendMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeAppend",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeAppend"
})
#endif
foreign import ccall "dzl_tree_node_clear_emblems" dzl_tree_node_clear_emblems ::
Ptr TreeNode ->
IO ()
treeNodeClearEmblems ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m ()
treeNodeClearEmblems :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m ()
treeNodeClearEmblems a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr TreeNode -> IO ()
dzl_tree_node_clear_emblems Ptr TreeNode
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeClearEmblemsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeClearEmblemsMethodInfo a signature where
overloadedMethod = treeNodeClearEmblems
instance O.OverloadedMethodInfo TreeNodeClearEmblemsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeClearEmblems",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeClearEmblems"
})
#endif
foreign import ccall "dzl_tree_node_collapse" dzl_tree_node_collapse ::
Ptr TreeNode ->
IO ()
treeNodeCollapse ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m ()
treeNodeCollapse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m ()
treeNodeCollapse a
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode -> IO ()
dzl_tree_node_collapse Ptr TreeNode
node'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeCollapseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeCollapseMethodInfo a signature where
overloadedMethod = treeNodeCollapse
instance O.OverloadedMethodInfo TreeNodeCollapseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeCollapse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeCollapse"
})
#endif
foreign import ccall "dzl_tree_node_expand" dzl_tree_node_expand ::
Ptr TreeNode ->
CInt ->
IO CInt
treeNodeExpand ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Bool
-> m Bool
treeNodeExpand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Bool -> m Bool
treeNodeExpand a
node Bool
expandAncestors = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
let expandAncestors' :: CInt
expandAncestors' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
expandAncestors
CInt
result <- Ptr TreeNode -> CInt -> IO CInt
dzl_tree_node_expand Ptr TreeNode
node' CInt
expandAncestors'
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
node
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeExpandMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeExpandMethodInfo a signature where
overloadedMethod = treeNodeExpand
instance O.OverloadedMethodInfo TreeNodeExpandMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeExpand",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeExpand"
})
#endif
foreign import ccall "dzl_tree_node_get_area" dzl_tree_node_get_area ::
Ptr TreeNode ->
Ptr Gdk.Rectangle.Rectangle ->
IO ()
treeNodeGetArea ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Gdk.Rectangle.Rectangle
-> m ()
treeNodeGetArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Rectangle -> m ()
treeNodeGetArea a
node Rectangle
area = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr Rectangle
area' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
area
Ptr TreeNode -> Ptr Rectangle -> IO ()
dzl_tree_node_get_area Ptr TreeNode
node' Ptr Rectangle
area'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
area
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetAreaMethodInfo
instance (signature ~ (Gdk.Rectangle.Rectangle -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetAreaMethodInfo a signature where
overloadedMethod = treeNodeGetArea
instance O.OverloadedMethodInfo TreeNodeGetAreaMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetArea",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetArea"
})
#endif
foreign import ccall "dzl_tree_node_get_children_possible" dzl_tree_node_get_children_possible ::
Ptr TreeNode ->
IO CInt
treeNodeGetChildrenPossible ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Bool
treeNodeGetChildrenPossible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Bool
treeNodeGetChildrenPossible a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr TreeNode -> IO CInt
dzl_tree_node_get_children_possible Ptr TreeNode
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetChildrenPossibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetChildrenPossibleMethodInfo a signature where
overloadedMethod = treeNodeGetChildrenPossible
instance O.OverloadedMethodInfo TreeNodeGetChildrenPossibleMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetChildrenPossible",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetChildrenPossible"
})
#endif
foreign import ccall "dzl_tree_node_get_expanded" dzl_tree_node_get_expanded ::
Ptr TreeNode ->
IO CInt
treeNodeGetExpanded ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Bool
treeNodeGetExpanded :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Bool
treeNodeGetExpanded a
node = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
CInt
result <- Ptr TreeNode -> IO CInt
dzl_tree_node_get_expanded Ptr TreeNode
node'
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
node
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetExpandedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetExpandedMethodInfo a signature where
overloadedMethod = treeNodeGetExpanded
instance O.OverloadedMethodInfo TreeNodeGetExpandedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetExpanded",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetExpanded"
})
#endif
foreign import ccall "dzl_tree_node_get_foreground_rgba" dzl_tree_node_get_foreground_rgba ::
Ptr TreeNode ->
IO (Ptr Gdk.RGBA.RGBA)
treeNodeGetForegroundRgba ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m (Maybe Gdk.RGBA.RGBA)
treeNodeGetForegroundRgba :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m (Maybe RGBA)
treeNodeGetForegroundRgba a
self = IO (Maybe RGBA) -> m (Maybe RGBA)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RGBA) -> m (Maybe RGBA))
-> IO (Maybe RGBA) -> m (Maybe RGBA)
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr RGBA
result <- Ptr TreeNode -> IO (Ptr RGBA)
dzl_tree_node_get_foreground_rgba Ptr TreeNode
self'
Maybe RGBA
maybeResult <- Ptr RGBA -> (Ptr RGBA -> IO RGBA) -> IO (Maybe RGBA)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RGBA
result ((Ptr RGBA -> IO RGBA) -> IO (Maybe RGBA))
-> (Ptr RGBA -> IO RGBA) -> IO (Maybe RGBA)
forall a b. (a -> b) -> a -> b
$ \Ptr RGBA
result' -> do
RGBA
result'' <- ((ManagedPtr RGBA -> RGBA) -> Ptr RGBA -> IO RGBA
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA) Ptr RGBA
result'
RGBA -> IO RGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RGBA
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe RGBA -> IO (Maybe RGBA)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RGBA
maybeResult
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetForegroundRgbaMethodInfo
instance (signature ~ (m (Maybe Gdk.RGBA.RGBA)), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetForegroundRgbaMethodInfo a signature where
overloadedMethod = treeNodeGetForegroundRgba
instance O.OverloadedMethodInfo TreeNodeGetForegroundRgbaMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetForegroundRgba",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetForegroundRgba"
})
#endif
foreign import ccall "dzl_tree_node_get_gicon" dzl_tree_node_get_gicon ::
Ptr TreeNode ->
IO (Ptr Gio.Icon.Icon)
treeNodeGetGicon ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Gio.Icon.Icon
treeNodeGetGicon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Icon
treeNodeGetGicon a
self = IO Icon -> m Icon
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr Icon
result <- Ptr TreeNode -> IO (Ptr Icon)
dzl_tree_node_get_gicon Ptr TreeNode
self'
Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeGetGicon" Ptr Icon
result
Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetGiconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetGiconMethodInfo a signature where
overloadedMethod = treeNodeGetGicon
instance O.OverloadedMethodInfo TreeNodeGetGiconMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetGicon",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetGicon"
})
#endif
foreign import ccall "dzl_tree_node_get_icon_name" dzl_tree_node_get_icon_name ::
Ptr TreeNode ->
IO CString
treeNodeGetIconName ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m T.Text
treeNodeGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Text
treeNodeGetIconName a
node = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
CString
result <- Ptr TreeNode -> IO CString
dzl_tree_node_get_icon_name Ptr TreeNode
node'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeGetIconName" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetIconNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetIconNameMethodInfo a signature where
overloadedMethod = treeNodeGetIconName
instance O.OverloadedMethodInfo TreeNodeGetIconNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetIconName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetIconName"
})
#endif
foreign import ccall "dzl_tree_node_get_item" dzl_tree_node_get_item ::
Ptr TreeNode ->
IO (Ptr GObject.Object.Object)
treeNodeGetItem ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m GObject.Object.Object
treeNodeGetItem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Object
treeNodeGetItem a
node = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr Object
result <- Ptr TreeNode -> IO (Ptr Object)
dzl_tree_node_get_item Ptr TreeNode
node'
Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeGetItem" Ptr Object
result
Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetItemMethodInfo
instance (signature ~ (m GObject.Object.Object), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetItemMethodInfo a signature where
overloadedMethod = treeNodeGetItem
instance O.OverloadedMethodInfo TreeNodeGetItemMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetItem",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetItem"
})
#endif
foreign import ccall "dzl_tree_node_get_iter" dzl_tree_node_get_iter ::
Ptr TreeNode ->
Ptr Gtk.TreeIter.TreeIter ->
IO CInt
treeNodeGetIter ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Gtk.TreeIter.TreeIter
-> m Bool
treeNodeGetIter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> TreeIter -> m Bool
treeNodeGetIter a
node TreeIter
iter = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeIter
iter' <- TreeIter -> IO (Ptr TreeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TreeIter
iter
CInt
result <- Ptr TreeNode -> Ptr TreeIter -> IO CInt
dzl_tree_node_get_iter Ptr TreeNode
node' Ptr TreeIter
iter'
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
node
TreeIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TreeIter
iter
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetIterMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetIterMethodInfo a signature where
overloadedMethod = treeNodeGetIter
instance O.OverloadedMethodInfo TreeNodeGetIterMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetIter",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetIter"
})
#endif
foreign import ccall "dzl_tree_node_get_parent" dzl_tree_node_get_parent ::
Ptr TreeNode ->
IO (Ptr TreeNode)
treeNodeGetParent ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m TreeNode
treeNodeGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m TreeNode
treeNodeGetParent a
node = IO TreeNode -> m TreeNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeNode -> m TreeNode) -> IO TreeNode -> m TreeNode
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode
result <- Ptr TreeNode -> IO (Ptr TreeNode)
dzl_tree_node_get_parent Ptr TreeNode
node'
Text -> Ptr TreeNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeGetParent" Ptr TreeNode
result
TreeNode
result' <- ((ManagedPtr TreeNode -> TreeNode) -> Ptr TreeNode -> IO TreeNode
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TreeNode -> TreeNode
TreeNode) Ptr TreeNode
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
TreeNode -> IO TreeNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreeNode
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetParentMethodInfo
instance (signature ~ (m TreeNode), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetParentMethodInfo a signature where
overloadedMethod = treeNodeGetParent
instance O.OverloadedMethodInfo TreeNodeGetParentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetParent",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetParent"
})
#endif
foreign import ccall "dzl_tree_node_get_path" dzl_tree_node_get_path ::
Ptr TreeNode ->
IO (Ptr Gtk.TreePath.TreePath)
treeNodeGetPath ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m (Maybe Gtk.TreePath.TreePath)
treeNodeGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m (Maybe TreePath)
treeNodeGetPath a
node = IO (Maybe TreePath) -> m (Maybe TreePath)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TreePath) -> m (Maybe TreePath))
-> IO (Maybe TreePath) -> m (Maybe TreePath)
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreePath
result <- Ptr TreeNode -> IO (Ptr TreePath)
dzl_tree_node_get_path Ptr TreeNode
node'
Maybe TreePath
maybeResult <- Ptr TreePath
-> (Ptr TreePath -> IO TreePath) -> IO (Maybe TreePath)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TreePath
result ((Ptr TreePath -> IO TreePath) -> IO (Maybe TreePath))
-> (Ptr TreePath -> IO TreePath) -> IO (Maybe TreePath)
forall a b. (a -> b) -> a -> b
$ \Ptr TreePath
result' -> do
TreePath
result'' <- ((ManagedPtr TreePath -> TreePath) -> Ptr TreePath -> IO TreePath
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TreePath -> TreePath
Gtk.TreePath.TreePath) Ptr TreePath
result'
TreePath -> IO TreePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreePath
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
Maybe TreePath -> IO (Maybe TreePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreePath
maybeResult
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetPathMethodInfo
instance (signature ~ (m (Maybe Gtk.TreePath.TreePath)), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetPathMethodInfo a signature where
overloadedMethod = treeNodeGetPath
instance O.OverloadedMethodInfo TreeNodeGetPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetPath"
})
#endif
foreign import ccall "dzl_tree_node_get_reset_on_collapse" dzl_tree_node_get_reset_on_collapse ::
Ptr TreeNode ->
IO CInt
treeNodeGetResetOnCollapse ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Bool
treeNodeGetResetOnCollapse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Bool
treeNodeGetResetOnCollapse a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr TreeNode -> IO CInt
dzl_tree_node_get_reset_on_collapse Ptr TreeNode
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetResetOnCollapseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetResetOnCollapseMethodInfo a signature where
overloadedMethod = treeNodeGetResetOnCollapse
instance O.OverloadedMethodInfo TreeNodeGetResetOnCollapseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetResetOnCollapse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetResetOnCollapse"
})
#endif
foreign import ccall "dzl_tree_node_get_text" dzl_tree_node_get_text ::
Ptr TreeNode ->
IO CString
treeNodeGetText ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m T.Text
treeNodeGetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Text
treeNodeGetText a
node = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
CString
result <- Ptr TreeNode -> IO CString
dzl_tree_node_get_text Ptr TreeNode
node'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeGetText" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetTextMethodInfo a signature where
overloadedMethod = treeNodeGetText
instance O.OverloadedMethodInfo TreeNodeGetTextMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetText",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetText"
})
#endif
foreign import ccall "dzl_tree_node_get_tree" dzl_tree_node_get_tree ::
Ptr TreeNode ->
IO (Ptr Dazzle.Tree.Tree)
treeNodeGetTree ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Dazzle.Tree.Tree
treeNodeGetTree :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Tree
treeNodeGetTree a
node = IO Tree -> m Tree
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Tree -> m Tree) -> IO Tree -> m Tree
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr Tree
result <- Ptr TreeNode -> IO (Ptr Tree)
dzl_tree_node_get_tree Ptr TreeNode
node'
Text -> Ptr Tree -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"treeNodeGetTree" Ptr Tree
result
Tree
result' <- ((ManagedPtr Tree -> Tree) -> Ptr Tree -> IO Tree
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Tree -> Tree
Dazzle.Tree.Tree) Ptr Tree
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
Tree -> IO Tree
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Tree
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetTreeMethodInfo
instance (signature ~ (m Dazzle.Tree.Tree), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetTreeMethodInfo a signature where
overloadedMethod = treeNodeGetTree
instance O.OverloadedMethodInfo TreeNodeGetTreeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetTree",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetTree"
})
#endif
foreign import ccall "dzl_tree_node_get_use_dim_label" dzl_tree_node_get_use_dim_label ::
Ptr TreeNode ->
IO CInt
treeNodeGetUseDimLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Bool
treeNodeGetUseDimLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Bool
treeNodeGetUseDimLabel a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr TreeNode -> IO CInt
dzl_tree_node_get_use_dim_label Ptr TreeNode
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetUseDimLabelMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetUseDimLabelMethodInfo a signature where
overloadedMethod = treeNodeGetUseDimLabel
instance O.OverloadedMethodInfo TreeNodeGetUseDimLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetUseDimLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetUseDimLabel"
})
#endif
foreign import ccall "dzl_tree_node_get_use_markup" dzl_tree_node_get_use_markup ::
Ptr TreeNode ->
IO CInt
treeNodeGetUseMarkup ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Bool
treeNodeGetUseMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Bool
treeNodeGetUseMarkup a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr TreeNode -> IO CInt
dzl_tree_node_get_use_markup Ptr TreeNode
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeGetUseMarkupMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeGetUseMarkupMethodInfo a signature where
overloadedMethod = treeNodeGetUseMarkup
instance O.OverloadedMethodInfo TreeNodeGetUseMarkupMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeGetUseMarkup",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeGetUseMarkup"
})
#endif
foreign import ccall "dzl_tree_node_has_emblem" dzl_tree_node_has_emblem ::
Ptr TreeNode ->
CString ->
IO CInt
treeNodeHasEmblem ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> T.Text
-> m Bool
treeNodeHasEmblem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Text -> m Bool
treeNodeHasEmblem a
self Text
emblemName = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
emblemName' <- Text -> IO CString
textToCString Text
emblemName
CInt
result <- Ptr TreeNode -> CString -> IO CInt
dzl_tree_node_has_emblem Ptr TreeNode
self' CString
emblemName'
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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
emblemName'
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeHasEmblemMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeHasEmblemMethodInfo a signature where
overloadedMethod = treeNodeHasEmblem
instance O.OverloadedMethodInfo TreeNodeHasEmblemMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeHasEmblem",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeHasEmblem"
})
#endif
foreign import ccall "dzl_tree_node_insert" dzl_tree_node_insert ::
Ptr TreeNode ->
Ptr TreeNode ->
Word32 ->
IO ()
treeNodeInsert ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a
-> b
-> Word32
-> m ()
treeNodeInsert :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a -> b -> Word32 -> m ()
treeNodeInsert a
self b
child Word32
position = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr TreeNode
child' <- b -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
Ptr TreeNode -> Ptr TreeNode -> Word32 -> IO ()
dzl_tree_node_insert Ptr TreeNode
self' Ptr TreeNode
child' Word32
position
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeInsertMethodInfo
instance (signature ~ (b -> Word32 -> m ()), MonadIO m, IsTreeNode a, IsTreeNode b) => O.OverloadedMethod TreeNodeInsertMethodInfo a signature where
overloadedMethod = treeNodeInsert
instance O.OverloadedMethodInfo TreeNodeInsertMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeInsert",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeInsert"
})
#endif
foreign import ccall "dzl_tree_node_insert_sorted" dzl_tree_node_insert_sorted ::
Ptr TreeNode ->
Ptr TreeNode ->
FunPtr Dazzle.Callbacks.C_TreeNodeCompareFunc ->
Ptr () ->
IO ()
treeNodeInsertSorted ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a
-> b
-> Dazzle.Callbacks.TreeNodeCompareFunc
-> m ()
treeNodeInsertSorted :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a -> b -> TreeNodeCompareFunc -> m ()
treeNodeInsertSorted a
node b
child TreeNodeCompareFunc
compareFunc = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode
child' <- b -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
FunPtr C_TreeNodeCompareFunc
compareFunc' <- C_TreeNodeCompareFunc -> IO (FunPtr C_TreeNodeCompareFunc)
Dazzle.Callbacks.mk_TreeNodeCompareFunc (Maybe (Ptr (FunPtr C_TreeNodeCompareFunc))
-> TreeNodeCompareFunc_WithClosures -> C_TreeNodeCompareFunc
Dazzle.Callbacks.wrap_TreeNodeCompareFunc Maybe (Ptr (FunPtr C_TreeNodeCompareFunc))
forall a. Maybe a
Nothing (TreeNodeCompareFunc -> TreeNodeCompareFunc_WithClosures
Dazzle.Callbacks.drop_closures_TreeNodeCompareFunc TreeNodeCompareFunc
compareFunc))
let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
Ptr TreeNode
-> Ptr TreeNode -> FunPtr C_TreeNodeCompareFunc -> Ptr () -> IO ()
dzl_tree_node_insert_sorted Ptr TreeNode
node' Ptr TreeNode
child' FunPtr C_TreeNodeCompareFunc
compareFunc' Ptr ()
forall a. Ptr a
userData
Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_TreeNodeCompareFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TreeNodeCompareFunc
compareFunc'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeInsertSortedMethodInfo
instance (signature ~ (b -> Dazzle.Callbacks.TreeNodeCompareFunc -> m ()), MonadIO m, IsTreeNode a, IsTreeNode b) => O.OverloadedMethod TreeNodeInsertSortedMethodInfo a signature where
overloadedMethod = treeNodeInsertSorted
instance O.OverloadedMethodInfo TreeNodeInsertSortedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeInsertSorted",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeInsertSorted"
})
#endif
foreign import ccall "dzl_tree_node_invalidate" dzl_tree_node_invalidate ::
Ptr TreeNode ->
IO ()
treeNodeInvalidate ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m ()
treeNodeInvalidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m ()
treeNodeInvalidate a
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode -> IO ()
dzl_tree_node_invalidate Ptr TreeNode
node'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeInvalidateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeInvalidateMethodInfo a signature where
overloadedMethod = treeNodeInvalidate
instance O.OverloadedMethodInfo TreeNodeInvalidateMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeInvalidate",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeInvalidate"
})
#endif
foreign import ccall "dzl_tree_node_is_root" dzl_tree_node_is_root ::
Ptr TreeNode ->
IO CInt
treeNodeIsRoot ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Bool
treeNodeIsRoot :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Bool
treeNodeIsRoot a
node = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
CInt
result <- Ptr TreeNode -> IO CInt
dzl_tree_node_is_root Ptr TreeNode
node'
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
node
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data TreeNodeIsRootMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeIsRootMethodInfo a signature where
overloadedMethod = treeNodeIsRoot
instance O.OverloadedMethodInfo TreeNodeIsRootMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeIsRoot",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeIsRoot"
})
#endif
foreign import ccall "dzl_tree_node_n_children" dzl_tree_node_n_children ::
Ptr TreeNode ->
IO Word32
treeNodeNChildren ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m Word32
treeNodeNChildren :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m Word32
treeNodeNChildren a
self = IO Word32 -> m Word32
forall a. IO a -> m a
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 TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Word32
result <- Ptr TreeNode -> IO Word32
dzl_tree_node_n_children Ptr TreeNode
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data TreeNodeNChildrenMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeNChildrenMethodInfo a signature where
overloadedMethod = treeNodeNChildren
instance O.OverloadedMethodInfo TreeNodeNChildrenMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeNChildren",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeNChildren"
})
#endif
foreign import ccall "dzl_tree_node_nth_child" dzl_tree_node_nth_child ::
Ptr TreeNode ->
Word32 ->
IO (Ptr TreeNode)
treeNodeNthChild ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Word32
-> m (Maybe TreeNode)
treeNodeNthChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Word32 -> m (Maybe TreeNode)
treeNodeNthChild a
self Word32
nth = IO (Maybe TreeNode) -> m (Maybe TreeNode)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TreeNode) -> m (Maybe TreeNode))
-> IO (Maybe TreeNode) -> m (Maybe TreeNode)
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr TreeNode
result <- Ptr TreeNode -> Word32 -> IO (Ptr TreeNode)
dzl_tree_node_nth_child Ptr TreeNode
self' Word32
nth
Maybe TreeNode
maybeResult <- Ptr TreeNode
-> (Ptr TreeNode -> IO TreeNode) -> IO (Maybe TreeNode)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TreeNode
result ((Ptr TreeNode -> IO TreeNode) -> IO (Maybe TreeNode))
-> (Ptr TreeNode -> IO TreeNode) -> IO (Maybe TreeNode)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeNode
result' -> do
TreeNode
result'' <- ((ManagedPtr TreeNode -> TreeNode) -> Ptr TreeNode -> IO TreeNode
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TreeNode -> TreeNode
TreeNode) Ptr TreeNode
result'
TreeNode -> IO TreeNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TreeNode
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe TreeNode -> IO (Maybe TreeNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TreeNode
maybeResult
#if defined(ENABLE_OVERLOADING)
data TreeNodeNthChildMethodInfo
instance (signature ~ (Word32 -> m (Maybe TreeNode)), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeNthChildMethodInfo a signature where
overloadedMethod = treeNodeNthChild
instance O.OverloadedMethodInfo TreeNodeNthChildMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeNthChild",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeNthChild"
})
#endif
foreign import ccall "dzl_tree_node_prepend" dzl_tree_node_prepend ::
Ptr TreeNode ->
Ptr TreeNode ->
IO ()
treeNodePrepend ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a
-> b
-> m ()
treeNodePrepend :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a -> b -> m ()
treeNodePrepend a
node b
child = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode
child' <- b -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
Ptr TreeNode -> Ptr TreeNode -> IO ()
dzl_tree_node_prepend Ptr TreeNode
node' Ptr TreeNode
child'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodePrependMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTreeNode a, IsTreeNode b) => O.OverloadedMethod TreeNodePrependMethodInfo a signature where
overloadedMethod = treeNodePrepend
instance O.OverloadedMethodInfo TreeNodePrependMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodePrepend",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodePrepend"
})
#endif
foreign import ccall "dzl_tree_node_rebuild" dzl_tree_node_rebuild ::
Ptr TreeNode ->
IO ()
treeNodeRebuild ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m ()
treeNodeRebuild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m ()
treeNodeRebuild a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr TreeNode -> IO ()
dzl_tree_node_rebuild Ptr TreeNode
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeRebuildMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeRebuildMethodInfo a signature where
overloadedMethod = treeNodeRebuild
instance O.OverloadedMethodInfo TreeNodeRebuildMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeRebuild",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeRebuild"
})
#endif
foreign import ccall "dzl_tree_node_remove" dzl_tree_node_remove ::
Ptr TreeNode ->
Ptr TreeNode ->
IO ()
treeNodeRemove ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a
-> b
-> m ()
treeNodeRemove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsTreeNode b) =>
a -> b -> m ()
treeNodeRemove a
node b
child = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode
child' <- b -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
Ptr TreeNode -> Ptr TreeNode -> IO ()
dzl_tree_node_remove Ptr TreeNode
node' Ptr TreeNode
child'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeRemoveMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTreeNode a, IsTreeNode b) => O.OverloadedMethod TreeNodeRemoveMethodInfo a signature where
overloadedMethod = treeNodeRemove
instance O.OverloadedMethodInfo TreeNodeRemoveMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeRemove",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeRemove"
})
#endif
foreign import ccall "dzl_tree_node_remove_emblem" dzl_tree_node_remove_emblem ::
Ptr TreeNode ->
CString ->
IO ()
treeNodeRemoveEmblem ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> T.Text
-> m ()
treeNodeRemoveEmblem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Text -> m ()
treeNodeRemoveEmblem a
self Text
emblemName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
emblemName' <- Text -> IO CString
textToCString Text
emblemName
Ptr TreeNode -> CString -> IO ()
dzl_tree_node_remove_emblem Ptr TreeNode
self' CString
emblemName'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
emblemName'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeRemoveEmblemMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeRemoveEmblemMethodInfo a signature where
overloadedMethod = treeNodeRemoveEmblem
instance O.OverloadedMethodInfo TreeNodeRemoveEmblemMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeRemoveEmblem",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeRemoveEmblem"
})
#endif
foreign import ccall "dzl_tree_node_select" dzl_tree_node_select ::
Ptr TreeNode ->
IO ()
treeNodeSelect ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> m ()
treeNodeSelect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> m ()
treeNodeSelect a
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr TreeNode -> IO ()
dzl_tree_node_select Ptr TreeNode
node'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSelectMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSelectMethodInfo a signature where
overloadedMethod = treeNodeSelect
instance O.OverloadedMethodInfo TreeNodeSelectMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSelect",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSelect"
})
#endif
foreign import ccall "dzl_tree_node_set_children_possible" dzl_tree_node_set_children_possible ::
Ptr TreeNode ->
CInt ->
IO ()
treeNodeSetChildrenPossible ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Bool
-> m ()
treeNodeSetChildrenPossible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Bool -> m ()
treeNodeSetChildrenPossible a
self Bool
childrenPossible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let childrenPossible' :: CInt
childrenPossible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
childrenPossible
Ptr TreeNode -> CInt -> IO ()
dzl_tree_node_set_children_possible Ptr TreeNode
self' CInt
childrenPossible'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetChildrenPossibleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetChildrenPossibleMethodInfo a signature where
overloadedMethod = treeNodeSetChildrenPossible
instance O.OverloadedMethodInfo TreeNodeSetChildrenPossibleMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetChildrenPossible",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetChildrenPossible"
})
#endif
foreign import ccall "dzl_tree_node_set_emblems" dzl_tree_node_set_emblems ::
Ptr TreeNode ->
CString ->
IO ()
treeNodeSetEmblems ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> T.Text
-> m ()
treeNodeSetEmblems :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Text -> m ()
treeNodeSetEmblems a
self Text
emblems = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
emblems' <- Text -> IO CString
textToCString Text
emblems
Ptr TreeNode -> CString -> IO ()
dzl_tree_node_set_emblems Ptr TreeNode
self' CString
emblems'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
emblems'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetEmblemsMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetEmblemsMethodInfo a signature where
overloadedMethod = treeNodeSetEmblems
instance O.OverloadedMethodInfo TreeNodeSetEmblemsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetEmblems",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetEmblems"
})
#endif
foreign import ccall "dzl_tree_node_set_foreground_rgba" dzl_tree_node_set_foreground_rgba ::
Ptr TreeNode ->
Ptr Gdk.RGBA.RGBA ->
IO ()
treeNodeSetForegroundRgba ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Maybe (Gdk.RGBA.RGBA)
-> m ()
treeNodeSetForegroundRgba :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Maybe RGBA -> m ()
treeNodeSetForegroundRgba a
self Maybe RGBA
foregroundRgba = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr RGBA
maybeForegroundRgba <- case Maybe RGBA
foregroundRgba of
Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
Just RGBA
jForegroundRgba -> do
Ptr RGBA
jForegroundRgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jForegroundRgba
Ptr RGBA -> IO (Ptr RGBA)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jForegroundRgba'
Ptr TreeNode -> Ptr RGBA -> IO ()
dzl_tree_node_set_foreground_rgba Ptr TreeNode
self' Ptr RGBA
maybeForegroundRgba
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
foregroundRgba RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetForegroundRgbaMethodInfo
instance (signature ~ (Maybe (Gdk.RGBA.RGBA) -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetForegroundRgbaMethodInfo a signature where
overloadedMethod = treeNodeSetForegroundRgba
instance O.OverloadedMethodInfo TreeNodeSetForegroundRgbaMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetForegroundRgba",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetForegroundRgba"
})
#endif
foreign import ccall "dzl_tree_node_set_gicon" dzl_tree_node_set_gicon ::
Ptr TreeNode ->
Ptr Gio.Icon.Icon ->
IO ()
treeNodeSetGicon ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, Gio.Icon.IsIcon b) =>
a
-> b
-> m ()
treeNodeSetGicon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsIcon b) =>
a -> b -> m ()
treeNodeSetGicon a
self b
icon = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr Icon
icon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
icon
Ptr TreeNode -> Ptr Icon -> IO ()
dzl_tree_node_set_gicon Ptr TreeNode
self' Ptr Icon
icon'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
icon
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetGiconMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTreeNode a, Gio.Icon.IsIcon b) => O.OverloadedMethod TreeNodeSetGiconMethodInfo a signature where
overloadedMethod = treeNodeSetGicon
instance O.OverloadedMethodInfo TreeNodeSetGiconMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetGicon",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetGicon"
})
#endif
foreign import ccall "dzl_tree_node_set_icon_name" dzl_tree_node_set_icon_name ::
Ptr TreeNode ->
CString ->
IO ()
treeNodeSetIconName ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Maybe (T.Text)
-> m ()
treeNodeSetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Maybe Text -> m ()
treeNodeSetIconName a
node Maybe Text
iconName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
CString
maybeIconName <- case Maybe Text
iconName of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
Just Text
jIconName -> do
CString
jIconName' <- Text -> IO CString
textToCString Text
jIconName
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconName'
Ptr TreeNode -> CString -> IO ()
dzl_tree_node_set_icon_name Ptr TreeNode
node' CString
maybeIconName
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconName
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetIconNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetIconNameMethodInfo a signature where
overloadedMethod = treeNodeSetIconName
instance O.OverloadedMethodInfo TreeNodeSetIconNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetIconName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetIconName"
})
#endif
foreign import ccall "dzl_tree_node_set_item" dzl_tree_node_set_item ::
Ptr TreeNode ->
Ptr GObject.Object.Object ->
IO ()
treeNodeSetItem ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, GObject.Object.IsObject b) =>
a
-> b
-> m ()
treeNodeSetItem :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsObject b) =>
a -> b -> m ()
treeNodeSetItem a
node b
item = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr Object
item' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
Ptr TreeNode -> Ptr Object -> IO ()
dzl_tree_node_set_item Ptr TreeNode
node' Ptr Object
item'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetItemMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTreeNode a, GObject.Object.IsObject b) => O.OverloadedMethod TreeNodeSetItemMethodInfo a signature where
overloadedMethod = treeNodeSetItem
instance O.OverloadedMethodInfo TreeNodeSetItemMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetItem",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetItem"
})
#endif
foreign import ccall "dzl_tree_node_set_reset_on_collapse" dzl_tree_node_set_reset_on_collapse ::
Ptr TreeNode ->
CInt ->
IO ()
treeNodeSetResetOnCollapse ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Bool
-> m ()
treeNodeSetResetOnCollapse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Bool -> m ()
treeNodeSetResetOnCollapse a
self Bool
resetOnCollapse = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let resetOnCollapse' :: CInt
resetOnCollapse' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
resetOnCollapse
Ptr TreeNode -> CInt -> IO ()
dzl_tree_node_set_reset_on_collapse Ptr TreeNode
self' CInt
resetOnCollapse'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetResetOnCollapseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetResetOnCollapseMethodInfo a signature where
overloadedMethod = treeNodeSetResetOnCollapse
instance O.OverloadedMethodInfo TreeNodeSetResetOnCollapseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetResetOnCollapse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetResetOnCollapse"
})
#endif
foreign import ccall "dzl_tree_node_set_text" dzl_tree_node_set_text ::
Ptr TreeNode ->
CString ->
IO ()
treeNodeSetText ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Maybe (T.Text)
-> m ()
treeNodeSetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Maybe Text -> m ()
treeNodeSetText a
node Maybe Text
text = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
CString
maybeText <- case Maybe Text
text of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
Just Text
jText -> do
CString
jText' <- Text -> IO CString
textToCString Text
jText
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jText'
Ptr TreeNode -> CString -> IO ()
dzl_tree_node_set_text Ptr TreeNode
node' CString
maybeText
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeText
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetTextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetTextMethodInfo a signature where
overloadedMethod = treeNodeSetText
instance O.OverloadedMethodInfo TreeNodeSetTextMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetText",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetText"
})
#endif
foreign import ccall "dzl_tree_node_set_use_dim_label" dzl_tree_node_set_use_dim_label ::
Ptr TreeNode ->
CInt ->
IO ()
treeNodeSetUseDimLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Bool
-> m ()
treeNodeSetUseDimLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Bool -> m ()
treeNodeSetUseDimLabel a
self Bool
useDimLabel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let useDimLabel' :: CInt
useDimLabel' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
useDimLabel
Ptr TreeNode -> CInt -> IO ()
dzl_tree_node_set_use_dim_label Ptr TreeNode
self' CInt
useDimLabel'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetUseDimLabelMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetUseDimLabelMethodInfo a signature where
overloadedMethod = treeNodeSetUseDimLabel
instance O.OverloadedMethodInfo TreeNodeSetUseDimLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetUseDimLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetUseDimLabel"
})
#endif
foreign import ccall "dzl_tree_node_set_use_markup" dzl_tree_node_set_use_markup ::
Ptr TreeNode ->
CInt ->
IO ()
treeNodeSetUseMarkup ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a) =>
a
-> Bool
-> m ()
treeNodeSetUseMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeNode a) =>
a -> Bool -> m ()
treeNodeSetUseMarkup a
self Bool
useMarkup = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
self' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let useMarkup' :: CInt
useMarkup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
useMarkup
Ptr TreeNode -> CInt -> IO ()
dzl_tree_node_set_use_markup Ptr TreeNode
self' CInt
useMarkup'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeSetUseMarkupMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTreeNode a) => O.OverloadedMethod TreeNodeSetUseMarkupMethodInfo a signature where
overloadedMethod = treeNodeSetUseMarkup
instance O.OverloadedMethodInfo TreeNodeSetUseMarkupMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeSetUseMarkup",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeSetUseMarkup"
})
#endif
foreign import ccall "dzl_tree_node_show_popover" dzl_tree_node_show_popover ::
Ptr TreeNode ->
Ptr Gtk.Popover.Popover ->
IO ()
treeNodeShowPopover ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeNode a, Gtk.Popover.IsPopover b) =>
a
-> b
-> m ()
treeNodeShowPopover :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTreeNode a, IsPopover b) =>
a -> b -> m ()
treeNodeShowPopover a
node b
popover = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr TreeNode
node' <- a -> IO (Ptr TreeNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
Ptr Popover
popover' <- b -> IO (Ptr Popover)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
popover
Ptr TreeNode -> Ptr Popover -> IO ()
dzl_tree_node_show_popover Ptr TreeNode
node' Ptr Popover
popover'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
popover
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TreeNodeShowPopoverMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTreeNode a, Gtk.Popover.IsPopover b) => O.OverloadedMethod TreeNodeShowPopoverMethodInfo a signature where
overloadedMethod = treeNodeShowPopover
instance O.OverloadedMethodInfo TreeNodeShowPopoverMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.TreeNode.treeNodeShowPopover",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TreeNode.html#v:treeNodeShowPopover"
})
#endif