rename {Thread,Tree}View

1 files changed, 229 insertions, 0 deletions

diff --git a/TreeView.hs b/TreeView.hs
new file mode 100644
index 0000000..89a4883
--- /dev/null
+++ b/TreeView.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+
+
+module TreeView where
+
+import Data.Default
+import Graphics.Vty
+
+import Data.List
+
+--import Data.Aeson
+--import Data.List.Split
+--import Data.Attoparsec.ByteString hiding (string)
+--import Data.Maybe
+import Data.Monoid
+--import Data.String
+--import Data.Traversable
+import Data.Tree
+--import qualified Data.ByteString as BS
+--import qualified Data.ByteString.Lazy as LBS
+--import qualified Data.ByteString.Char8 as BS8
+--import qualified Data.Text.Lazy as TL
+import qualified Data.Text as T
+--import qualified Data.Text.Encoding as T
+--import qualified Data.Text.IO as T
+--import Data.Version (Version(..), parseVersion)
+--import System.Process
+--import System.IO
+--import qualified Data.Map as M
+
+import Notmuch.Message
+import Notmuch.SearchResult
+import Safe
+
+
+type LineNr = Int
+
+
+data TreeView
+    = TVMessage Message
+    | TVMessagePart Message MessagePart
+    | TVMessageLine Message MessagePart LineNr String
+    | TVSearch String
+    | TVSearchResult SearchResult
+  deriving (Show)
+
+instance Eq TreeView where
+    TVMessage m1 == TVMessage m2 =
+        m1 == m2
+
+    TVMessagePart m1 mp1 == TVMessagePart m2 mp2 =
+        m1 == m2 && mp1 == mp2
+
+    TVMessageLine m1 mp1 ln1 _s1 == TVMessageLine m2 mp2 ln2 _s2 =
+        m1 == m2 && mp1 == mp2 && ln1 == ln2
+
+    TVSearch s1 == TVSearch s2 =
+        s1 == s2
+
+    TVSearchResult s1 == TVSearchResult s2 =
+        s1 == s2
+
+    _ == _ = False
+
+
+isTVSearchResult :: TreeView -> Bool
+isTVSearchResult (TVSearchResult _) = True
+isTVSearchResult _ = False
+
+
+describe :: TreeView -> String
+describe (TVMessage m) = "TVMessage " <> unMessageID (messageId m)
+describe (TVMessagePart m p) = "TVMessagePart " <> (unMessageID $ messageId m) <> " " <> show (partID p)
+describe (TVMessageLine _ _ _ s) = "TVMessageLine " <> show s
+describe (TVSearch s) = "TVSearch " <> show s
+describe (TVSearchResult sr) = "TVSearchResult " <> show (searchTotal sr)
+
+
+findMessage :: MessageID -> Tree TreeView -> Maybe TreeView
+findMessage i =
+    find p . flatten
+  where
+    p (TVMessage m) = i == messageId m
+    p _ = False
+
+findTV :: TreeView -> Tree TreeView -> Maybe TreeView
+findTV x =
+    find (==x) . flatten
+
+
+fromSearchResults :: String -> [SearchResult] -> Tree TreeView
+fromSearchResults query =
+    Node (TVSearch query) . map (\r -> Node (TVSearchResult r) [])
+
+
+fromMessageTree :: Tree Message -> Tree TreeView
+fromMessageTree (Node m ms) =
+    Node m' ms'
+  where
+
+    m' :: TreeView
+    m' = TVMessage m
+
+    ms' :: Forest TreeView
+    ms' = if isOpen m
+              then xconvBody m <> map fromMessageTree ms
+              else map fromMessageTree ms
+
+xconvBody :: Message -> Forest TreeView
+xconvBody m = mconcat $ map (xconvPart m) (messageBody m)
+
+xconvPart :: Message -> MessagePart -> Forest TreeView
+xconvPart m p = xconvPartContent m p $ partContent p
+
+xconvPartContent
+  :: Message -> MessagePart -> MessageContent -> Forest TreeView
+xconvPartContent m p = \case
+    ContentText t ->
+        map (xconvLine m p) $ zip [0..] (T.lines t)
+    ContentMultipart parts ->
+        map (xconvPart2 m) parts
+        -- [Node (TVMessageLine m p 0 "ContentMultipart") []]
+    ContentMsgRFC822 _ ->
+        [Node (TVMessageLine m p 0 "ContentMsgRFC822") []]
+
+
+xconvPart2 :: Message -> MessagePart -> Tree TreeView
+xconvPart2 m p =
+    Node (TVMessagePart m p) $ xconvPartContent m p (partContent p)
+
+
+xconvLine
+  :: Message -> MessagePart -> (LineNr, T.Text) -> Tree TreeView
+xconvLine m p (i, s) =
+    Node (TVMessageLine m p i $ T.unpack s) []
+
+
+
+treeViewImage :: Bool -> TreeView -> Image
+treeViewImage hasFocus = \case
+    TVMessage m ->
+        let col = if isOpen m then om else cm
+        in
+        string col (unMessageID $ messageId m)
+        <|>
+        translateX 1 (
+          horizCat $
+              intersperse (string col ", ") $
+              map (text' tagColor) $
+              messageTags m
+        )
+
+    TVMessagePart _ p ->
+        string mp "TVMessagePart"
+          <|> translateX 1 (string mp $ show $ partID p)
+          <|> translateX 1 (string mp $ show $ partContentType p)
+
+    TVMessageLine _ _ _ s ->
+        string ml s
+
+    TVSearch s ->
+        string sColor s
+
+    TVSearchResult sr -> do
+        let ThreadID tid = searchThread sr
+        --string srColor tid
+        -- <|>
+        --translateX 1
+        (string srColor $ padl 11 ' ' $ T.unpack $ searchDateRel sr)
+        <|>
+        string srColor " ("
+        <|>
+        (string srColor $ show $ searchMatched sr)
+        <|>
+        string srColor ")"
+        <|>
+        string srColor "  "
+        -- <|>
+        -- (string srColor $ show $ searchTime sr)
+        <|>
+        (string srColor $ T.unpack $ searchSubject sr)
+  where
+    --c1 = if hasFocus then c1_focus else c1_nofocus
+    --c1_nofocus = withForeColor def $ Color240 $ -16 + 238
+    --c1_focus = withForeColor def $ Color240 $ -16 + 244
+    --c2 = withForeColor def $ Color240 $ -16 + 106
+    --c3 = withForeColor def $ Color240 $ -16 + 199
+
+    tagColor = if hasFocus then tagColor_y else tagColor_n
+    tagColor_y = withForeColor def $ color 230
+    tagColor_n = withForeColor def $ color 200
+
+    cm = if hasFocus then cm_y else cm_n
+    cm_y = withForeColor def $ color 46
+    cm_n = withForeColor def $ color 22
+
+    om = if hasFocus then om_y else om_n
+    om_y = withForeColor def $ color 82
+    om_n = withForeColor def $ color 58
+
+    ml = if hasFocus then ml_y else ml_n
+    ml_y = withForeColor def $ color 226
+    ml_n = withForeColor def $ color 202
+
+    --ph = if hasFocus then ph_y else ph_n
+    --ph_y = withForeColor def $ color 241
+    --ph_n = withForeColor def $ color 235
+
+    mp = if hasFocus then mp_y else mp_n
+    mp_y = withForeColor def $ color 199
+    mp_n = withForeColor def $ color 162
+
+    sColor = if hasFocus then sColor_y else sColor_n
+    sColor_y = withForeColor def $ color 196
+    sColor_n = withForeColor def $ color  88
+
+    srColor = if hasFocus then srColor_y else srColor_n
+    srColor_y = withForeColor def $ color 197
+    srColor_n = withForeColor def $ color  89
+
+    color i = Color240 $ -16 + i
+
+
+
+padl n c s =
+    if length s < n
+        then padl n c (c:s)
+        else s