From 86f9991deeb44a6cc81044e61a9ad3ee001c5ced Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sat, 18 Apr 2015 15:46:44 +0200
Subject: Send both plain text and html in mail notifications

---
 src/View/Ad.hs       | 92 ----------------------------------------------------
 src/View/Html/Ad.hs  | 77 +++++++++++++++++++++++++++++++++++++++++++
 src/View/Plain/Ad.hs | 88 +++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 165 insertions(+), 92 deletions(-)
 delete mode 100644 src/View/Ad.hs
 create mode 100644 src/View/Html/Ad.hs
 create mode 100644 src/View/Plain/Ad.hs

(limited to 'src/View')

diff --git a/src/View/Ad.hs b/src/View/Ad.hs
deleted file mode 100644
index ec5da2d..0000000
--- a/src/View/Ad.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Ad
-  ( renderConsoleAds
-  , renderAds
-  ) where
-
-import Data.List (intersperse)
-import Data.Maybe (fromMaybe)
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Model.Ad (Ad(..))
-import qualified Model.Ad as Ad
-
-import Model.Resume (Resume(..))
-import qualified Model.Resume as Resume
-
-import Model.Detail (Detail(..))
-import qualified Model.Detail as Detail
-
-import Model.URL
-
-renderConsoleAds :: Text -> [Ad] -> Text
-renderConsoleAds time ads =
-  let (title, message) = renderAds ads
-      titleWithTime =
-        T.concat
-          [ "\n["
-          , time
-          , "] "
-          , title
-          ]
-      line = T.map (\_ -> '-') titleWithTime
-  in  T.intercalate
-        "\n"
-        [ titleWithTime
-        , line
-        , ""
-        , message
-        ]
-
-renderAds :: [Ad] -> (Text, Text)
-renderAds ads =
-  let titleMessage = renderTitle $ length ads
-      adsMessage = T.intercalate "\n\n" . map renderAd $ ads
-  in  (titleMessage, adsMessage)
-
-renderTitle :: Int -> Text
-renderTitle count =
-  T.concat
-    [ T.pack . show $ count
-    , agreement " nouvelle"
-    , agreement " annonce"
-    ]
-  where agreement word =
-          T.concat
-            [ word
-            , if count > 1 then "s" else ""
-            ]
-
-renderAd :: Ad -> Text
-renderAd ad =
-  T.concat
-    [ renderResume (Ad.resume ad)
-    , "\n\n"
-    , renderDetail (Ad.detail ad)
-    ]
-
-renderResume :: Resume -> Text
-renderResume resume =
-  let formatPrice price = T.concat [" - ", price]
-      price = fromMaybe "" . fmap formatPrice . Resume.price $ resume
-      titleLine = T.concat [Resume.name resume, price]
-  in  T.intercalate "\n" [titleLine, Resume.url resume]
-
-renderDetail :: Detail -> Text
-renderDetail detail =
-  T.concat
-    [ fromMaybe "−" (Detail.description 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
-    ]
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/Plain/Ad.hs b/src/View/Plain/Ad.hs
new file mode 100644
index 0000000..9dc5289
--- /dev/null
+++ b/src/View/Plain/Ad.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module View.Plain.Ad
+  ( renderConsoleAds
+  , renderAds
+  ) where
+
+import Data.List (intersperse)
+import Data.Maybe (fromMaybe)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Model.Ad (Ad(..))
+import qualified Model.Ad as Ad
+
+import Model.Resume (Resume(..))
+import qualified Model.Resume as Resume
+
+import Model.Detail (Detail(..))
+import qualified Model.Detail as Detail
+
+import Model.URL
+
+renderConsoleAds :: Text -> [Ad] -> Text
+renderConsoleAds time ads =
+  let (title, message) = renderAds ads
+      titleWithTime =
+        T.concat
+          [ "\n["
+          , time
+          , "] "
+          , title
+          ]
+      line = T.map (\_ -> '-') titleWithTime
+  in  T.intercalate
+        "\n"
+        [ titleWithTime
+        , line
+        , ""
+        , message
+        ]
+
+renderAds :: [Ad] -> (Text, Text)
+renderAds ads =
+  let titleMessage = renderTitle $ length ads
+      adsMessage = T.intercalate "\n\n" . map renderAd $ ads
+  in  (titleMessage, adsMessage)
+
+renderTitle :: Int -> Text
+renderTitle count =
+  T.concat
+    [ T.pack . show $ count
+    , agreement " nouvelle"
+    , agreement " annonce"
+    ]
+  where agreement word =
+          T.concat
+            [ word
+            , if count > 1 then "s" else ""
+            ]
+
+renderAd :: Ad -> Text
+renderAd ad =
+  T.concat
+    [ renderResume (Ad.resume ad)
+    , "\n\n"
+    , renderDetail (Ad.detail ad)
+    ]
+
+renderResume :: Resume -> Text
+renderResume resume =
+  let formatPrice price = T.concat [" - ", price]
+      price = fromMaybe "" . fmap formatPrice . Resume.price $ resume
+      titleLine = T.concat [Resume.name resume, price]
+  in  T.intercalate "\n" [titleLine, Resume.url resume]
+
+renderDetail :: Detail -> Text
+renderDetail detail =
+  T.concat
+    [ fromMaybe "−" (Detail.description detail)
+    , renderURLs "\n\nImages:" (Detail.images detail)
+    ]
+
+renderURLs :: Text -> [URL] -> Text
+renderURLs title [] = ""
+renderURLs title urls =
+  T.intercalate "\n" (title:urls)
-- 
cgit v1.2.3