From f8fd5d62f15a91cb9938ddc99a9e92337b19584b Mon Sep 17 00:00:00 2001 From: Joscha Date: Sat, 8 Feb 2020 23:11:54 +0000 Subject: [PATCH] Add unfinished client Tree type --- src/Forest/Client/Node.hs | 63 ++++++++++++++++++++++++++++++++++ src/Forest/Client/Tree.hs | 72 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 135 insertions(+) create mode 100644 src/Forest/Client/Node.hs create mode 100644 src/Forest/Client/Tree.hs diff --git a/src/Forest/Client/Node.hs b/src/Forest/Client/Node.hs new file mode 100644 index 0000000..3622395 --- /dev/null +++ b/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 diff --git a/src/Forest/Client/Tree.hs b/src/Forest/Client/Tree.hs new file mode 100644 index 0000000..dd4a94c --- /dev/null +++ b/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 + }