From 948dd729fc022884319c85cc5c850c115bf4cc91 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Thu, 25 Dec 2014 11:54:14 +0100
Subject: rename {Thread,Tree}View

---
 ThreadView.hs | 229 ----------------------------------------------------------
 TreeView.hs   | 229 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test3.hs      |  22 +++---
 3 files changed, 240 insertions(+), 240 deletions(-)
 delete mode 100644 ThreadView.hs
 create mode 100644 TreeView.hs

diff --git a/ThreadView.hs b/ThreadView.hs
deleted file mode 100644
index 2b1c1fb..0000000
--- a/ThreadView.hs
+++ /dev/null
@@ -1,229 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
-
-
-module ThreadView 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 ThreadView
-    = TVMessage Message
-    | TVMessagePart Message MessagePart
-    | TVMessageLine Message MessagePart LineNr String
-    | TVSearch String
-    | TVSearchResult SearchResult
-  deriving (Show)
-
-instance Eq ThreadView 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 :: ThreadView -> Bool
-isTVSearchResult (TVSearchResult _) = True
-isTVSearchResult _ = False
-
-
-describe :: ThreadView -> 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 ThreadView -> Maybe ThreadView
-findMessage i =
-    find p . flatten
-  where
-    p (TVMessage m) = i == messageId m
-    p _ = False
-
-findTV :: ThreadView -> Tree ThreadView -> Maybe ThreadView
-findTV x =
-    find (==x) . flatten
-
-
-fromSearchResults :: String -> [SearchResult] -> Tree ThreadView
-fromSearchResults query =
-    Node (TVSearch query) . map (\r -> Node (TVSearchResult r) [])
-
-
-fromMessageTree :: Tree Message -> Tree ThreadView
-fromMessageTree (Node m ms) =
-    Node m' ms'
-  where
-
-    m' :: ThreadView
-    m' = TVMessage m
-
-    ms' :: Forest ThreadView
-    ms' = if isOpen m
-              then xconvBody m <> map fromMessageTree ms
-              else map fromMessageTree ms
-
-xconvBody :: Message -> Forest ThreadView
-xconvBody m = mconcat $ map (xconvPart m) (messageBody m)
-
-xconvPart :: Message -> MessagePart -> Forest ThreadView
-xconvPart m p = xconvPartContent m p $ partContent p
-
-xconvPartContent
-  :: Message -> MessagePart -> MessageContent -> Forest ThreadView
-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 ThreadView
-xconvPart2 m p =
-    Node (TVMessagePart m p) $ xconvPartContent m p (partContent p)
-
-
-xconvLine
-  :: Message -> MessagePart -> (LineNr, T.Text) -> Tree ThreadView
-xconvLine m p (i, s) =
-    Node (TVMessageLine m p i $ T.unpack s) []
-
-
-
-threadViewImage :: Bool -> ThreadView -> Image
-threadViewImage 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
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
diff --git a/test3.hs b/test3.hs
index 6de1617..e35db25 100644
--- a/test3.hs
+++ b/test3.hs
@@ -38,7 +38,7 @@ import Notmuch.SearchResult
 
 import Control.Exception
 
-import ThreadView
+import TreeView
 
 import TreeSearch
 
@@ -105,8 +105,8 @@ main =
         rec vty 0 (Z.fromTree v)
 
     --rec vty t_cur t = do
-    --rec :: Vty -> Int -> Z.TreePos Z.Full ThreadView -> Tree ThreadView -> IO ()
-    rec :: Vty -> Int -> Z.TreePos Z.Full ThreadView -> IO ()
+    --rec :: Vty -> Int -> Z.TreePos Z.Full TreeView -> Tree TreeView -> IO ()
+    rec :: Vty -> Int -> Z.TreePos Z.Full TreeView -> IO ()
     rec vty i c = do
         let
             img =
@@ -117,7 +117,7 @@ main =
                 --string def (maybe "Nothing" describe (focusPrev v c)) <->
                 --string def (describe $ Z.label c) <->
                 --string def (maybe "Nothing" describe (focusNext v c)) <->
-                threadImage (Just $ Z.label c) (Z.toTree c)
+                treeImage (Just $ Z.label c) (Z.toTree c)
             pic = picForImage img
             v = Z.root c
         update vty pic
@@ -166,17 +166,17 @@ main =
                 rec vty 0 $ Z.modifyTree (\(Node l _) -> Node l t_) loc
 
 
-threadImage :: Maybe ThreadView -> Tree ThreadView -> Image
---threadImage t_cur (Node n ns) =
-threadImage c (Node n ns) =
+treeImage :: Maybe TreeView -> Tree TreeView -> Image
+--treeImage t_cur (Node n ns) =
+treeImage c (Node n ns) =
     --messageImage hasFocus n
-    --threadViewImage (hasFocus n) n
-    threadViewImage (c == Just n) n
+    --treeViewImage (hasFocus n) n
+    treeViewImage (c == Just n) n
     <->
-    translateX 2 (vertCat $ map (threadImage c) ns)
+    translateX 2 (vertCat $ map (treeImage c) ns)
   --where
   --  --hasFocus = t_cur == messageId n
-  --  hasFocus :: ThreadView -> Bool
+  --  hasFocus :: TreeView -> Bool
   --  hasFocus (TVMessage m) = c == m
   --  hasFocus _ = False
 
-- 
cgit v1.2.3