Add unfinished client Tree type

src/Forest/Client/Node.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Forest.Client.Node
+  ( DrawState(..)
+  , renderNode
+  ) where
+
+import           Brick
+import qualified Data.Map                   as Map
+import qualified Data.Set                   as Set
+
+import           Forest.Api
+import           Forest.Client.NodeEditor
+import           Forest.Client.ResourceName
+import           Forest.Tree
+
+data DrawState = DrawState
+  { dsEditor   :: Maybe NodeEditor
+  , dsFocused  :: Maybe Path
+  , dsUnfolded :: Set.Set Path
+  }
+
+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 "| " <+>)
+
+drawSubnode :: NodeId -> DrawState -> Node -> Widget ResourceName
+drawSubnode nodeId ds node =
+  let newDs = narrowDrawState nodeId ds
+  in  indent $ renderNode newDs node
+
+drawSubnodes :: DrawState -> Map.Map NodeId Node -> Widget ResourceName
+drawSubnodes ds nodes = vBox $
+  map (\(nodeId, node) -> drawSubnode 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
+  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

src/Forest/Client/Tree.hs

@@ -0,0 +1,72 @@
+module Forest.Client.Tree
+  ( Tree(..)
+  , newTree
+  , renderTree
+  , toggleFold
+  , moveFocusUp
+  , moveFocusDown
+  , switchNode
+  ) where
+
+import           Brick
+import qualified Data.Set                   as Set
+
+import           Forest.Api
+import           Forest.Client.Node
+import           Forest.Client.NodeEditor
+import           Forest.Client.ResourceName
+import           Forest.Tree
+
+data Tree = Tree
+  { treeNode     :: Node
+  , treeFocused  :: Path
+  , treeUnfolded :: Set.Set Path
+  } deriving (Show)
+
+newTree :: Node -> Tree
+newTree node = Tree
+  { treeNode     = node
+  , treeFocused  = Path []
+  , treeUnfolded = Set.empty
+  }
+
+renderTree :: Maybe NodeEditor -> Tree -> Widget ResourceName
+renderTree maybeEditor tree = renderNode drawState $ treeNode tree
+  where
+    drawState = DrawState
+      { dsEditor   = maybeEditor
+      , dsFocused  = Just $ treeFocused tree
+      , dsUnfolded = treeUnfolded tree
+      }
+
+isCurrentFolded :: Tree -> Bool
+isCurrentFolded tree = treeFocused tree `Set.member` treeUnfolded tree
+
+foldCurrent :: Tree -> Tree
+foldCurrent tree@Tree {treeFocused = f, treeUnfolded = u} =
+  tree {treeUnfolded = Set.delete f u}
+
+unfoldCurrent :: Tree -> Tree
+unfoldCurrent tree@Tree {treeFocused = f, treeUnfolded = u} =
+  tree {treeUnfolded = Set.insert f u}
+
+toggleFold :: Tree -> Tree
+toggleFold tree
+  | isCurrentFolded tree = unfoldCurrent tree
+  | otherwise            = foldCurrent tree
+
+moveFocusUp :: Tree -> Tree
+moveFocusUp = id -- TODO implement properly
+
+moveFocusDown :: Tree -> Tree
+moveFocusDown = id -- TODO implement properly
+
+findNearestFocus :: Node -> Path -> Path
+findNearestFocus _ _ = localPath -- TODO implement properly
+
+switchNode :: Node -> Tree -> Tree
+switchNode node tree = Tree
+  { treeNode = node
+  , treeFocused = findNearestFocus node $ treeFocused tree
+  , treeUnfolded = Set.filter (isValidPath node) $ treeUnfolded tree
+  }