{-# LANGUAGE OverloadedStrings #-}
module UI.Index.Main (
renderListOfThreads
, renderListOfMails) where
import Brick.Types (Padding(..), Widget)
import Brick.AttrMap (AttrName, attrName)
import Brick.Widgets.Core
(hBox, hLimitPercent, padRight, padLeft, txt, vLimit, withAttr, (<+>))
import qualified Brick.Widgets.List as L
import Control.Lens.Getter (view)
import Data.Time.Clock
(UTCTime(..), NominalDiffTime, nominalDay, diffUTCTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Text as T (Text, pack, unpack, unwords)
import Notmuch (getTag)
import UI.Draw.Main (fillLine)
import Storage.Notmuch (hasTag, ManageTags)
import Types
import Config.Main
(listAttr, listStateNewmailAttr, listStateSelectedAttr,
listStateToggledAttr, mailAuthorsAttr, mailTagAttr)
renderListOfThreads :: AppState -> Widget Name
renderListOfThreads s = L.renderList (listDrawThread s) True $ view (asMailIndex . miListOfThreads) s
renderListOfMails :: AppState -> Widget Name
renderListOfMails s = L.renderList (listDrawMail s) True $ view (asMailIndex . miListOfMails) s
notmuchConfig :: AppState -> NotmuchSettings FilePath
notmuchConfig = view (asConfig . confNotmuch)
isNewMail :: ManageTags a => a -> AppState -> Bool
isNewMail a s = hasTag (view nmNewTag (notmuchConfig s)) a
renderListAttr, authorsAttr, tagsAttr ::
ManageTags a
=> a
-> AppState
-> Bool
-> Bool
-> AttrName
renderListAttr a s = makeListStateAttr listAttr (isNewMail a s)
authorsAttr a s = makeListStateAttr mailAuthorsAttr (isNewMail a s)
tagsAttr a s = makeListStateAttr mailTagAttr (isNewMail a s)
listDrawMail :: AppState -> Bool -> Toggleable NotmuchMail -> Widget Name
listDrawMail s sel (toggled, a) =
let widget = hBox
[ padLeft (Pad 1) (txt $ formatDate (view mailDate a) (view asLocalTime s))
, padLeft (Pad 1) (renderAuthors (authorsAttr a s sel toggled) $ view mailFrom a)
, padLeft (Pad 1) (renderTagsWidget' (tagsAttr a s sel toggled) (view mailTags a) (view nmNewTag (notmuchConfig s)))
, txt (view mailSubject a)
, fillLine
]
in withAttr (renderListAttr a s sel toggled) widget
listDrawThread :: AppState -> Bool -> Toggleable NotmuchThread -> Widget Name
listDrawThread s sel (toggled, a) =
let widget = hBox
[ padLeft (Pad 1) (txt $ formatDate (view thDate a) (view asLocalTime s))
, padLeft (Pad 1) (renderAuthors (authorsAttr a s sel toggled) $ T.unwords $ view thAuthors a)
, padLeft (Pad 1) (txt $ pack $ "(" <> show (view thReplies a) <> ")")
, padLeft (Pad 1) (renderTagsWidget' (tagsAttr a s sel toggled) (view thTags a) (view nmNewTag (notmuchConfig s)))
, txt (view thSubject a)
, fillLine
]
in withAttr (renderListAttr a s sel toggled) widget
makeListStateAttr ::
AttrName
-> Bool
-> Bool
-> Bool
-> AttrName
makeListStateAttr baseAttr isNew isSelected isToggled =
let newAttr = if isNew then listStateNewmailAttr else mempty
selectedAttr = if isSelected then listStateSelectedAttr else mempty
toggledAttr = if isToggled then listStateToggledAttr else mempty
in baseAttr <> selectedAttr <> toggledAttr <> newAttr
calendarYear :: NominalDiffTime
calendarYear = nominalDay * 365
formatDate :: UTCTime -> UTCTime -> Text
formatDate mail now =
let format =
if calendarYear < diffUTCTime now mail
then "%b'%y"
else "%d/%b"
in pack $ formatTime defaultTimeLocale format (utctDay mail)
renderAuthors :: AttrName -> Text -> Widget Name
renderAuthors attr authors =
withAttr attr $ hLimitPercent 20 (txt authors <+> fillLine)
renderTagsWidget' :: AttrName -> [Tag] -> Tag -> Widget Name
renderTagsWidget' baseattr tgs ignored =
let ts = filter (/= ignored) tgs
render tag = padRight (Pad 1) $ withAttr (toAttrName baseattr tag) $ txt (decodeLenient $ getTag tag)
in vLimit 1 $ hBox $ render <$> ts
toAttrName :: AttrName -> Tag -> AttrName
toAttrName baseattr = (baseattr <>) . attrName . unpack . decodeLenient . getTag