diff --git a/client/Main.hs b/client/Main.hs index 98a4a03..8e75372 100644 --- a/client/Main.hs +++ b/client/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Main where import Brick @@ -14,6 +12,7 @@ import Forest.Api import Forest.Client.NodeEditor import Forest.Client.ResourceName import Forest.Client.Tree +import Forest.Client.WidgetTree import Forest.Node import Forest.Util @@ -49,7 +48,7 @@ newClientState node = ClientState } clientDraw :: ClientState -> [Widget ResourceName] -clientDraw cs = [renderTree (csEditor cs) (csTree cs)] +clientDraw cs = [renderTree boxDrawingBranching (csEditor cs) (csTree cs)] clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState) clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs diff --git a/src/Forest/Client/Node.hs b/src/Forest/Client/Node.hs index bb55d28..4b4e2fc 100644 --- a/src/Forest/Client/Node.hs +++ b/src/Forest/Client/Node.hs @@ -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 diff --git a/src/Forest/Client/Tree.hs b/src/Forest/Client/Tree.hs index 3a922d7..dda92a0 100644 --- a/src/Forest/Client/Tree.hs +++ b/src/Forest/Client/Tree.hs @@ -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 }