From cb8229edc65b8eb6e85932efcfbc6f1c44196a39 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Sun, 4 Jan 2015 14:39:55 +0100
Subject: renderTreeView: renderPrefix

---
 RenderTreeView.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++-----
 TreeView.hs       |  7 ++++++
 test5.hs          |  2 +-
 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)
-- 
cgit v1.2.3