Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Render nodes using new WidgetTree

Browse source
This commit is contained in:
Joscha 2020-02-09 09:48:21 +00:00
parent 4c63b96ae5
commit 6036ff4c77
3 changed files with 34 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

56
src/Forest/Client/Node.hs
View file

@ -2,7 +2,7 @@
module Forest.Client.Node
( DrawState(..)
, renderNode
, nodeToTree
) where
import Brick
@ -11,6 +11,7 @@ import qualified Data.Set as Set
import Forest.Client.NodeEditor
import Forest.Client.ResourceName
import Forest.Client.WidgetTree
import Forest.Node
data DrawState = DrawState
@ -19,44 +20,39 @@ data DrawState = DrawState
, dsUnfolded :: Set.Set Path
}
isFocused :: DrawState -> Bool
isFocused ds = (isLocalPath <$> dsFocused ds) == Just True
narrowDrawState :: NodeId -> DrawState -> DrawState
narrowDrawState nodeId ds = ds
{ dsUnfolded = narrowSet nodeId $ dsUnfolded ds
, dsFocused = narrowPath nodeId =<< dsFocused ds
}
indent :: Widget n -> Widget n
indent = (txt "│ " <+>)
nodeToWidget :: Bool -> Node -> Widget ResourceName
nodeToWidget focused node =
let nodeWidget = txt $ nodeText node
expandStyle = if null (nodeChildren node) then "noexpand" else "expand"
focusStyle = if focused then "focus" else "nofocus"
in withAttr focusStyle $ withAttr expandStyle nodeWidget
drawSubnode :: NodeId -> DrawState -> Node -> Widget ResourceName
drawSubnode nodeId ds node =
subnodeToTree :: NodeId -> DrawState -> Node -> WidgetTree ResourceName
subnodeToTree nodeId ds node =
let newDs = narrowDrawState nodeId ds
in indent $ renderNode newDs node
in nodeToTree newDs node
drawSubnodes :: DrawState -> Map.Map NodeId Node -> Widget ResourceName
drawSubnodes ds nodes = vBox $
map (\(nodeId, node) -> drawSubnode nodeId ds node) $
subnodesToTrees :: DrawState -> Map.Map NodeId Node -> [WidgetTree ResourceName]
subnodesToTrees ds nodes =
map (\(nodeId, node) -> subnodeToTree nodeId ds node) $
Map.toAscList nodes
isFocused :: DrawState -> Bool
isFocused ds = (isLocalPath <$> dsFocused ds) == Just True
drawNodeWithoutEditor :: DrawState -> Node -> Widget ResourceName
drawNodeWithoutEditor ds node
| isFocused ds = withAttr "focused" nodeWidget <=> subnodesWidget
| otherwise = nodeWidget <=> subnodesWidget
nodeToTree :: DrawState -> Node -> WidgetTree ResourceName
nodeToTree ds node = case dsEditor ds of
Nothing -> WidgetTree nodeWidget subnodeWidgets
Just ed
| asReply ed -> WidgetTree nodeWidget (subnodeWidgets ++ [WidgetTree (renderNodeEditor ed) []])
| otherwise -> WidgetTree (renderNodeEditor ed) subnodeWidgets
where
nodeWidget = txt $ nodeText node
subnodesWidget = drawSubnodes ds $ nodeChildren node
drawNodeWithEditor :: NodeEditor -> DrawState -> Node -> Widget ResourceName
drawNodeWithEditor ed ds node
| asReply ed = drawNodeWithoutEditor ds node <=> indent (renderNodeEditor ed)
| otherwise = renderNodeEditor ed <=> drawSubnodes ds (nodeChildren node)
renderNode :: DrawState -> Node -> Widget ResourceName
renderNode ds node
| isFocused ds = case dsEditor ds of
Nothing -> drawNodeWithoutEditor ds node
Just ed -> drawNodeWithEditor ed ds node
| otherwise = drawNodeWithoutEditor ds node
focused = isFocused ds
nodeWidget = nodeToWidget focused node
subnodeWidgets = subnodesToTrees ds $ nodeChildren node

10
src/Forest/Client/Tree.hs
View file

@ -14,6 +14,7 @@ import qualified Data.Set as Set
import Forest.Client.Node
import Forest.Client.NodeEditor
import Forest.Client.ResourceName
import Forest.Client.WidgetTree
import Forest.Node
data Tree = Tree
@ -29,12 +30,13 @@ newTree node = Tree
, treeUnfolded = Set.empty
}
renderTree :: Maybe NodeEditor -> Tree -> Widget ResourceName
renderTree maybeEditor tree = renderNode drawState $ treeNode tree
renderTree :: IndentOptions -> Maybe NodeEditor -> Tree -> Widget ResourceName
renderTree opts maybeEditor tree =
renderWidgetTree opts $ nodeToTree drawState $ treeNode tree
where
drawState = DrawState
{ dsEditor = maybeEditor
, dsFocused = Just $ treeFocused tree
{ dsEditor = maybeEditor
, dsFocused = Just $ treeFocused tree
, dsUnfolded = treeUnfolded tree
}