Initial commit

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" ""