diff options
Diffstat (limited to 'src/Template.hs')
-rw-r--r-- | src/Template.hs | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/src/Template.hs b/src/Template.hs new file mode 100644 index 0000000..ff13bd3 --- /dev/null +++ b/src/Template.hs @@ -0,0 +1,67 @@ +module Template (inbox, mail) where + +import Common (replace) +import qualified Common.Mime as Mime +import Data.List (intercalate) +import Data.Maybe (fromMaybe) +import qualified Html as H +import Intro +import qualified Mail as M +import qualified Mail.Header as H + +inbox :: [M.Mail] -> [String] +inbox xs = + [ H.p [show $ length xs, " messages."] + , H.table $ inboxHeader : zipWith (curry inboxRow) [0 ..] xs + ] + +inboxHeader :: String +inboxHeader = H.tr [H.th ["Subject"], H.th ["From"], H.th ["To"]] + +inboxRow :: (Int, M.Mail) -> String +inboxRow (i, m) = + H.tr + [ H.td [H.a [("href", "/mail/" ++ show i)] [fromMaybe "No subject" (M.subject m)]] + , H.td [M.from m] + , H.td (M.to m) + ] + +mail :: M.Mail -> [String] +mail m = + [ H.a [("href", "/")] ["Inbox"] + , H.p ["From: ", M.from m] + , H.p ["To: ", intercalate ", " $ M.to m] + , H.table (mailHeader <$> m.headers) + , H.hr + , H.main_ (fmap (H.div_ [("class", "part")] . mailPart) m.body) + ] + +mailHeader :: M.Header -> String +mailHeader (k, v) = H.tr [H.td [k], H.td [v]] + +mailPart :: M.Part -> [String] +mailPart p = + [ H.table (mailHeader <$> p.headers) + , H.div_ [("class", "part-body")] [mailPartBody p] + ] + +mailPartBody :: M.Part -> String +mailPartBody p = case (mimeType, encoding) of + (Just (Mime.Image _), Just "base64") -> H.img [("src", concat ["data:", show mimeType, ";base64,", p.body])] + (_, Just "quoted-printable") -> H.iframe [("srcdoc", decodeQP p.body)] [] + _ -> H.iframe [("srcdoc", p.body)] [] + where + mimeType = (H.contentType p.headers) >>= Mime.getType . H.mime + encoding = H.contentTransferEncoding p.headers + +-- "Handles" the "quoted-printable" encoding: +-- https://datatracker.ietf.org/doc/html/rfc1521#section-5.1 +-- This is just wrong (or, wronger than the rest), but this part of the spec +-- is crazy, so, whatever. +decodeQP :: String -> String +decodeQP = + replace "=3D" "=" + . replace "=C2" "" + . replace "=A0" " " + . replace "=\r" "" + . replace "=\r\n" "" |