diff options
Diffstat (limited to 'TreeViewRaw.hs')
| -rw-r--r-- | TreeViewRaw.hs | 152 |
1 files changed, 104 insertions, 48 deletions
diff --git a/TreeViewRaw.hs b/TreeViewRaw.hs index db4a899..b10f3e6 100644 --- a/TreeViewRaw.hs +++ b/TreeViewRaw.hs @@ -9,72 +9,128 @@ 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 Trammel import TreeView -import Utils (padl) -renderTreeView :: TreeView -> Tree TreeView -> [Trammel String] -renderTreeView cur _loc@(Node label children) = - [ colorize $ renderTreeView1 hasFocus label ] ++ - concatMap (map (" "<>) . renderTreeView cur) children +-- 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 - colorize s = - if hasFocus - then SGR [31] s - else s -renderTreeView1 :: Bool -> TreeView -> Trammel String -renderTreeView1 hasFocus = \case +-- TODO locale-style: headerKey = \s -> SGR [..] (s <> ": ") + +searchSGR, focusSGR, boringSGR, dateSGR, tagsSGR, unreadMessageSGR, + unreadSearchSGR :: Trammel String -> Trammel String +searchSGR = SGR [38,5,162] +focusSGR = SGR [38,5,160] +boringSGR = SGR [38,5,240] +dateSGR = SGR [38,5,071] +tagsSGR = SGR [38,5,036] + +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 -> - Plain s + let c = if hasFocus then focusSGR else searchSGR + in c $ Plain s TVSearchResult sr -> - let c = case (hasFocus, "unread" `elem` Notmuch.searchTags sr) of - (False, False) -> SGR [38,5,240] - (False, True) -> SGR [38,5,250] - (True, False) -> SGR [38,5,088] - (True, True) -> SGR [38,5,160] - in c $ - Plain ( - (padl 11 ' ' $ T.unpack $ Notmuch.searchDateRel sr) - ++ " (" ++ (show $ Notmuch.searchMatched sr) ++ ") " - ++ (T.unpack $ Notmuch.searchSubject sr) - ++ " " - ) - <> - mconcat (L.intersperse " " (map (SGR [38,5,036] . Plain . T.unpack) $ Notmuch.searchTags 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 = case (hasFocus, "unread" `elem` Notmuch.messageTags m) of - (False, False) -> SGR [38,5,240] - (False, True) -> SGR [38,5,250] - (True, False) -> SGR [38,5,088] - (True, True) -> SGR [38,5,160] - in c $ - Plain ( - (Notmuch.unMessageID $ Notmuch.messageId m) - ++ " " - ++ T.unpack (T.intercalate (T.pack ",") $ Notmuch.messageTags m) - ) - - TVMessageHeaderField m fieldName -> Plain $ - let k = T.unpack $ CI.original fieldName + 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" - T.unpack + (Plain . T.unpack) (M.lookup fieldName $ Notmuch.messageHeaders m) - in k ++ ": " ++ v + in c $ k <> ": " <> v - TVMessagePart _ p -> Plain $ - "part#" - ++ (show $ Notmuch.partID p) - ++ " " - ++ (T.unpack $ CI.original $ Notmuch.partContentType p) + 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 + in c $ "part#" <> i <> " " <> t TVMessageLine _ _ _ s -> - Plain 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 :: [T.Text] -> Trammel String +renderTags ts = + Plain $ T.unpack $ T.intercalate " " ts + + +dropAddress :: String -> String +dropAddress xs = + case L.findIndices (=='<') xs of + [] -> xs + is -> L.dropWhileEnd isSpace $ take (last is) xs |