module UI.Mail.Main (renderMailView) where
import Brick.Types (Padding(..), ViewportType(..), Widget)
import Brick.Widgets.Core
(padTop, txt, txtWrap, viewport, (<+>), (<=>), withAttr, vBox)
import Control.Applicative ((<|>))
import Control.Lens (filtered, firstOf, folded, to, toListOf, view, preview)
import qualified Data.ByteString as B
import qualified Data.CaseInsensitive as CI
import Data.Semigroup ((<>))
import Data.Text.Lens (packed)
import qualified Data.Text as T
import Data.MIME
import Types
import Config.Main (headerKeyAttr, headerValueAttr, mailViewAttr)
renderMailView :: AppState -> Widget Name
renderMailView s = viewport ScrollingMailView Vertical (mailView s (view (asMailView . mvMail) s))
mailView :: AppState -> Maybe MIMEMessage -> Widget Name
mailView s (Just msg) = withAttr mailViewAttr $ messageToMailView s msg
mailView _ Nothing = txt "Eeek: this is not supposed to happen"
messageToMailView :: AppState -> MIMEMessage -> Widget Name
messageToMailView s msg =
let
wantHeader :: CI.CI B.ByteString -> Bool
wantHeader = case view (asMailView . mvHeadersState) s of
Filtered -> view (asConfig . confMailView . mvHeadersToShow) s
ShowAll -> const True
filteredHeaders =
toListOf (headerList . folded . filtered (wantHeader . fst)) msg
headerToWidget :: (CI.CI B.ByteString, B.ByteString) -> Widget Name
headerToWidget (k, v) =
withAttr headerKeyAttr $
txt (decodeLenient (CI.original k) <> ": ")
<+> withAttr headerValueAttr (txtWrap (decodeEncodedWords v))
headerWidgets = headerToWidget <$> filteredHeaders
bodyWidget = padTop (Pad 1) (maybe (txt "No entity selected") entityToView ent)
ent = chooseEntity s msg
in
vBox headerWidgets <=> padTop (Pad 1) bodyWidget
chooseEntity :: AppState -> MIMEMessage -> Maybe WireEntity
chooseEntity s msg =
let
preferredContentType = view (asConfig . confMailView . mvPreferredContentType) s
match x = matchContentType
(view (headers . contentType . ctType) x)
(preview (headers . contentType . ctSubtype) x)
preferredContentType
in firstOf (entities . filtered match) msg <|> firstOf entities msg
entityToView :: WireEntity -> Widget Name
entityToView msg = txtWrap . either err (view body) $
view transferDecoded msg >>= view charsetDecoded
where
err :: EncodingError -> T.Text
err e =
"ERROR: " <> view (to show . packed) e <> ". Showing raw body.\n\n"
<> decodeLenient (view body msg)