summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--RenderTreeView.hs66
-rw-r--r--TreeView.hs7
-rw-r--r--test5.hs2
3 files changed, 69 insertions, 6 deletions
diff --git a/RenderTreeView.hs b/RenderTreeView.hs
index b08ff14..5d1a9bf 100644
--- a/RenderTreeView.hs
+++ b/RenderTreeView.hs
@@ -9,6 +9,8 @@ import qualified Data.CaseInsensitive as CI
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
+import qualified Data.Tree.Zipper as Z
+import qualified TreeZipperUtils as Z
import Data.Char
import Data.Monoid
import Data.Time
@@ -39,12 +41,64 @@ humanTimeLocale = defaultHumanTimeLocale
}
-renderTreeView :: UTCTime -> TreeView -> Tree TreeView -> [Trammel String]
-renderTreeView now cur _loc@(Node label children) =
- [ renderTreeView1 now hasFocus label ] ++
- concatMap (map (" "<>) . renderTreeView now cur) children
+renderTreeView
+ :: UTCTime
+ -> Z.TreePos Z.Full TreeView
+ -> Z.TreePos Z.Full TreeView
+ -> [Trammel String]
+renderTreeView now cur =
+ renderNode
where
- hasFocus = cur == label
+ isFocus = (Z.label cur==) . Z.label
+
+ renderNode loc =
+ renderRootLabel loc :
+ maybeRenderSubForest (Z.firstChild loc)
+
+ renderRootLabel loc =
+ renderPrefix loc <>
+ renderTreeView1 now (isFocus loc) (Z.label loc)
+
+ renderSubForest loc =
+ renderNode loc ++
+ maybeRenderSubForest (Z.next loc)
+
+ maybeRenderSubForest =
+ maybe mempty renderSubForest
+
+
+renderPrefix :: Z.TreePos Z.Full TreeView -> Trammel String
+renderPrefix =
+ mconcat . reverse . map prefix . zip [(1 :: Int)..] . Z.path
+ where
+ prefix (i, (_lhs, x, rhs)) = case x of
+ TVSearch _ -> ""
+ TVSearchResult _ -> spacePrefix
+ TVMessage _ ->
+ case i of
+ 1 ->
+ if null rhs
+ then endPrefix
+ else teePrefix
+ _ ->
+ if null rhs
+ then spacePrefix
+ else pipePrefix
+ _ ->
+ if null $ filter isTVMessage $ map rootLabel rhs
+ then spacePrefix
+ else pipePrefix
+
+
+spacePrefix
+ , teePrefix
+ , pipePrefix
+ , endPrefix
+ :: Trammel String
+spacePrefix = prefixSGR " "
+teePrefix = prefixSGR "├╴"
+pipePrefix = prefixSGR "│ "
+endPrefix = prefixSGR "└╴"
-- TODO locale-style: headerKey = \s -> SGR [..] (s <> ": ")
@@ -53,6 +107,7 @@ searchSGR
, focusSGR
, quoteSGR
, boringSGR
+ , prefixSGR
, dateSGR
, tagsSGR
, unreadMessageSGR
@@ -64,6 +119,7 @@ searchSGR = SGR [38,5,162]
focusSGR = SGR [38,5,160]
quoteSGR = SGR [38,5,242]
boringSGR = SGR [38,5,240]
+prefixSGR = SGR [38,5,235]
dateSGR = SGR [38,5,071]
tagsSGR = SGR [38,5,036]
killedTagSGR = SGR [38,5,088]
diff --git a/TreeView.hs b/TreeView.hs
index 3ea7fd4..a03b3ee 100644
--- a/TreeView.hs
+++ b/TreeView.hs
@@ -5,6 +5,7 @@
module TreeView
( TreeView (..)
, getMessage
+ , isTVMessage
, isTVSearchResult
, fromSearchResults
, fromMessageForest
@@ -69,6 +70,12 @@ getMessage = \case
_ -> Nothing
+isTVMessage :: TreeView -> Bool
+isTVMessage = \case
+ TVMessage _ -> True
+ _ -> False
+
+
isTVSearchResult :: TreeView -> Bool
isTVSearchResult (TVSearchResult _) = True
isTVSearchResult _ = False
diff --git a/test5.hs b/test5.hs
index ffb168e..6f01838 100644
--- a/test5.hs
+++ b/test5.hs
@@ -177,7 +177,7 @@ render q@State{..} =
, headBuffer = newHeadBuf
}
where
- newTreeBuf = renderTreeView now (Z.label cursor) (Z.toTree cursor)
+ newTreeBuf = renderTreeView now cursor (Z.root cursor)
newHeadBuf =
[ Plain (show screenWidth) <> "x" <> Plain (show screenHeight)
<> " " <> Plain (show $ linearPos cursor - yoffset)