purge a bit of legacy & cruft

There's still both around, though..^_^

1 files changed, 11 insertions, 158 deletions

diff --git a/TreeView.hs b/TreeView.hs
index ed91ce8..d1b0c95 100644
--- a/TreeView.hs
+++ b/TreeView.hs
@@ -2,34 +2,20 @@
 {-# LANGUAGE LambdaCase #-}
 
 
-module TreeView where
+module TreeView
+    ( TreeView (..)
+    , getMessage
+    , isTVSearchResult
+    , fromSearchResults
+    , fromMessageForest
+    , fromMessageTree
+    ) 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.CaseInsensitive as CI
 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 Data.Monoid
+import Data.Tree
 import Notmuch.Message
 import Notmuch.SearchResult
 
@@ -46,6 +32,7 @@ data TreeView
     | TVSearchResult SearchResult
   deriving (Show)
 
+
 instance Eq TreeView where
     TVMessage m1 == TVMessage m2 =
         m1 == m2
@@ -82,27 +69,6 @@ isTVSearchResult (TVSearchResult _) = True
 isTVSearchResult _ = False
 
 
-describe :: TreeView -> String
-describe (TVMessage m) = "TVMessage " <> unMessageID (messageId m)
-describe (TVMessageHeaderField m k) = "TVMessageHeaderField " <> unMessageID (messageId m) <> " " <> T.unpack (CI.original k)
-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) [])
@@ -162,116 +128,3 @@ 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
-        )
-
-    TVMessageHeaderField m fieldName ->
-        let k = string mhf $ T.unpack $ CI.original fieldName
-            v = maybe (string mhf_empty "nothing")
-                      (string mhf . T.unpack)
-                      (M.lookup fieldName $ messageHeaders m)
-        in k <|> string mhf ": " <|> v
-
-    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)
-        <|>
-        --(string srColor $ T.unpack $ searchThread sr)
-        (translateX 1 $ let ThreadID tid = searchThread sr in string srColor tid)
-        --string srColor tid
-  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
-
-    mhf = if hasFocus then mhf_y else mhf_n
-    mhf_y = withForeColor def $ color 248
-    mhf_n = withForeColor def $ color 244
-
-    mhf_empty = if hasFocus then mhf_empty_y else mhf_empty_n
-    mhf_empty_y = withForeColor def $ color 88
-    mhf_empty_n = withForeColor def $ color 52
-
-    --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 :: Int -> a -> [a] -> [a]
-padl n c s =
-    if length s < n
-        then padl n c (c:s)
-        else s