{-# 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.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 Notmuch.Message import Notmuch.SearchResult type LineNr = Int data TreeView = TVMessage Message | TVMessageHeaderField Message (CI.CI T.Text) | TVMessagePart Message MessagePart | TVMessageLine Message MessagePart LineNr String | TVSearch String | TVSearchResult SearchResult deriving (Show) instance Eq TreeView where TVMessage m1 == TVMessage m2 = m1 == m2 TVMessageHeaderField m1 mhf1 == TVMessageHeaderField m2 mhf2 = m1 == m2 && mhf1 == mhf2 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 (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) []) fromMessageForest :: Forest Message -> Forest TreeView fromMessageForest = map fromMessageTree 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 xconvHead m <> xconvBody m <> map fromMessageTree ms else map fromMessageTree ms xconvHead :: Message -> Forest TreeView xconvHead m = map conv [ "From", "To" ] -- TODO add Subject if it differs from thread subject where conv k = Node (TVMessageHeaderField m k) [] 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 ) 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) 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