diff options
author | tv <tv@shackspace.de> | 2015-01-04 14:39:55 +0100 |
---|---|---|
committer | tv <tv@shackspace.de> | 2015-01-04 14:39:55 +0100 |
commit | cb8229edc65b8eb6e85932efcfbc6f1c44196a39 (patch) | |
tree | 13321b3be543e857949c1a39a6ff3f22106379cd /RenderTreeView.hs | |
parent | 95d67c694aac052bef162eb0d07422ab575d94e5 (diff) |
renderTreeView: renderPrefix
Diffstat (limited to 'RenderTreeView.hs')
-rw-r--r-- | RenderTreeView.hs | 66 |
1 files changed, 61 insertions, 5 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] |