diff options
author | tv <tv@shackspace.de> | 2015-01-03 13:17:38 +0100 |
---|---|---|
committer | tv <tv@shackspace.de> | 2015-01-03 13:17:38 +0100 |
commit | 170cbdae59cd8c56b69f8a2d890c7ef8ce5378d1 (patch) | |
tree | 062b491b024546b7ec5337dc7810f1ce2f860516 /RenderTreeView.hs | |
parent | 11d3bf814d5eef82de34e2b987de3fb6293b59d2 (diff) |
TreeViewRaw -> RenderTreeView
Diffstat (limited to 'RenderTreeView.hs')
-rw-r--r-- | RenderTreeView.hs | 166 |
1 files changed, 166 insertions, 0 deletions
diff --git a/RenderTreeView.hs b/RenderTreeView.hs new file mode 100644 index 0000000..b08ff14 --- /dev/null +++ b/RenderTreeView.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module RenderTreeView (renderTreeView) where + +import qualified Notmuch.Message as Notmuch +import qualified Notmuch.SearchResult as Notmuch +import qualified Data.CaseInsensitive as CI +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Text as T +import Data.Char +import Data.Monoid +import Data.Time +import Data.Time.Format.Human +import Data.Tree +import TagUtils (Tag) +import Trammel +import TreeView + + +-- TODO make configurable +humanTimeLocale :: HumanTimeLocale +humanTimeLocale = defaultHumanTimeLocale + { justNow = "now" + , secondsAgo = (++ "s ago") + , oneMinuteAgo = "1m ago" + , minutesAgo = (++ "m ago") + , oneHourAgo = "1h ago" + , aboutHoursAgo = (++ "h ago") + , at = \_ -> ("" ++) + , daysAgo = (++ "d ago") + , weekAgo = (++ "w ago") + , weeksAgo = (++ "w ago") + , onYear = ("" ++) + , dayOfWeekFmt = "%a %H:%M" + , thisYearFmt = "%b %e" + , prevYearFmt = "%b %e, %Y" + } + + +renderTreeView :: UTCTime -> TreeView -> Tree TreeView -> [Trammel String] +renderTreeView now cur _loc@(Node label children) = + [ renderTreeView1 now hasFocus label ] ++ + concatMap (map (" "<>) . renderTreeView now cur) children + where + hasFocus = cur == label + + +-- TODO locale-style: headerKey = \s -> SGR [..] (s <> ": ") + +searchSGR + , focusSGR + , quoteSGR + , boringSGR + , dateSGR + , tagsSGR + , unreadMessageSGR + , unreadSearchSGR + , killedTagSGR + , starTagSGR + :: Trammel String -> Trammel String +searchSGR = SGR [38,5,162] +focusSGR = SGR [38,5,160] +quoteSGR = SGR [38,5,242] +boringSGR = SGR [38,5,240] +dateSGR = SGR [38,5,071] +tagsSGR = SGR [38,5,036] +killedTagSGR = SGR [38,5,088] +starTagSGR = SGR [38,5,226] + +unreadMessageSGR = SGR [38,5,117] +unreadSearchSGR = SGR [38,5,250] + + +renderTreeView1 :: UTCTime -> Bool -> TreeView -> Trammel String +renderTreeView1 now hasFocus x = case x of + + TVSearch s -> + let c = if hasFocus then focusSGR else searchSGR + in c $ Plain s + + TVSearchResult sr -> + let c = if hasFocus then focusSGR else + if "unread" `elem` Notmuch.searchTags sr + then unreadSearchSGR + else boringSGR + date = dateSGR $ renderDate now x + tags = tagsSGR $ renderTags (Notmuch.searchTags sr) + subj = Plain $ T.unpack $ Notmuch.searchSubject sr + in c $ subj <> " " <> date <> " " <> tags + + TVMessage m -> + let c = if hasFocus then focusSGR else + if "unread" `elem` Notmuch.messageTags m + then unreadMessageSGR + else boringSGR + from = renderFrom (M.lookup "from" $ Notmuch.messageHeaders m) + date = dateSGR $ renderDate now x + tags = tagsSGR $ renderTags (Notmuch.messageTags m) -- TODO filter common tags + in c $ from <> " " <> date <> " " <> tags + + TVMessageHeaderField m fieldName -> + let c = if hasFocus then focusSGR else boringSGR + k = Plain $ T.unpack $ CI.original fieldName + v = maybe "nothing" + (Plain . T.unpack) + (M.lookup fieldName $ Notmuch.messageHeaders m) + in c $ k <> ": " <> v + + TVMessagePart _ p -> + let c = if hasFocus then focusSGR else boringSGR + i = Plain $ show $ Notmuch.partID p + t = Plain $ T.unpack $ CI.original $ Notmuch.partContentType p + filename = maybe "" (Plain . (" "<>) . show) $ Notmuch.partContentFilename p + charset = maybe "" (Plain . (" "<>) . show) $ Notmuch.partContentCharset p + in c $ "part#" <> i <> " " <> t <> filename <> charset + + TVMessageQuoteLine _ _ _ s -> + if hasFocus + then focusSGR $ Plain s + else quoteSGR $ Plain s + + TVMessageLine _ _ _ s -> + if hasFocus + then focusSGR $ Plain s + else Plain s + + + +renderDate :: UTCTime -> TreeView -> Trammel String +renderDate now = \case + TVSearchResult sr -> f humanTimeLocale (Notmuch.searchTime sr) + TVMessage m -> f humanTimeLocale (Notmuch.messageTime m) + _ -> SGR [35,1] "timeless" + where + f timeLocale time = + Plain $ humanReadableTimeI18N' timeLocale now time + + +renderFrom :: Maybe T.Text -> Trammel String +renderFrom = \case + Just fromLine -> Plain $ dropAddress $ T.unpack fromLine + Nothing -> SGR [35,1] "Anonymous" + + +renderTags :: [Tag] -> Trammel String +renderTags = + -- TODO sort somewhere else + mconcat . L.intersperse " " . map renderTag . L.sort + + +renderTag :: Tag -> Trammel String +renderTag tag = case tag of + "killed" -> killedTagSGR plain + "star" -> starTagSGR plain + _ -> plain + where + plain = Plain $ T.unpack tag + + +dropAddress :: String -> String +dropAddress xs = + case L.findIndices (=='<') xs of + [] -> xs + is -> L.dropWhileEnd isSpace $ take (last is) xs |