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/Html/Ad.hs | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 src/View/Html/Ad.hs (limited to 'src/View/Html') 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) -- cgit v1.2.3