diff options
Diffstat (limited to 'TreeView.hs')
| -rw-r--r-- | TreeView.hs | 229 |
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 |