aboutsummaryrefslogtreecommitdiff
path: root/src/Template.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Template.hs')
-rw-r--r--src/Template.hs67
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" ""