Send both plain text and html in mail notifications

2 files changed, 80 insertions, 7 deletions

diff --git a/src/View/Html/Ad.hs b/src/View/Html/Ad.hs
new file mode 100644
index 0000000..fce164e
--- /dev/null
+++ b/src/View/Html/Ad.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module View.Html.Ad
+  ( renderAds
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Lazy (toStrict)
+import Data.Maybe (fromMaybe)
+import Data.String (fromString)
+import Data.List (intersperse)
+
+import Text.Blaze.Html
+import Text.Blaze.Html5 (Html)
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import Text.Blaze.Html.Renderer.Text (renderHtml)
+import Text.Blaze.Internal (textValue)
+
+import Model.Ad
+import qualified Model.Ad as A
+
+import Model.Resume (Resume)
+import qualified Model.Resume as R
+
+import Model.Detail (Detail)
+import qualified Model.Detail as D
+
+import Model.URL
+
+renderAds :: [Ad] -> Text
+renderAds = toStrict . renderHtml . adsHtml
+
+adsHtml :: [Ad] -> Html
+adsHtml ads = H.div (mapM_ adHtml ads)
+
+adHtml :: Ad -> Html
+adHtml ad =
+  let resume = A.resume ad
+      detail = A.detail ad
+  in  do
+        resumeHtml resume
+        detailHtml detail
+
+resumeHtml :: Resume -> Html
+resumeHtml resume =
+  let title =
+        T.concat
+          [ R.name resume
+          , fromMaybe "" . fmap (\p -> T.concat [" - ", p]) $ R.price resume
+          ]
+      url = R.url resume
+  in  do
+        H.h1 (toHtml title)
+        linkHtml url
+
+detailHtml :: Detail -> Html
+detailHtml detail = do
+  case D.description detail of
+    Just description ->
+      descriptionHtml description
+    Nothing ->
+      H.div ""
+  mapM_ imageLinkHtml (D.images detail)
+
+descriptionHtml :: Text -> Html
+descriptionHtml = H.p . sequence_ . intersperse H.br . fmap toHtml . T.lines
+
+linkHtml :: URL -> Html
+linkHtml url =
+  H.a ! A.href (textValue url) $ (toHtml url)
+
+imageLinkHtml :: URL -> Html
+imageLinkHtml url =
+  H.a ! A.href (textValue url) $
+    H.img ! A.src (textValue url)
diff --git a/src/View/Ad.hs b/src/View/Plain/Ad.hs
index ec5da2d..9dc5289 100644
--- a/src/View/Ad.hs
+++ b/src/View/Plain/Ad.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module View.Ad
+module View.Plain.Ad
   ( renderConsoleAds
   , renderAds
   ) where
@@ -79,14 +79,10 @@ renderDetail :: Detail -> Text
 renderDetail detail =
   T.concat
     [ fromMaybe "−" (Detail.description detail)
-    , renderURLs "\n\nImages" (Detail.images detail)
+    , renderURLs "\n\nImages:" (Detail.images detail)
     ]
 
 renderURLs :: Text -> [URL] -> Text
 renderURLs title [] = ""
 renderURLs title urls =
-  T.concat
-    [ title
-    , "\n\n"
-    , T.intercalate "\n" urls
-    ]
+  T.intercalate "\n" (title:urls)