From 78048fcbc81521d145b79b4b47761a8b698d7ff7 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sun, 19 Apr 2015 12:14:50 +0200
Subject: Adding a design to the HTML mail + Adding waitInMinutes in the
 configuration

---
 src/View/Html/Ad.hs     | 39 +++++++++++++++++++++++----------------
 src/View/Html/Design.hs | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 58 insertions(+), 16 deletions(-)
 create mode 100644 src/View/Html/Design.hs

(limited to 'src/View/Html')

diff --git a/src/View/Html/Ad.hs b/src/View/Html/Ad.hs
index f3d9ece..2d6bdb5 100644
--- a/src/View/Html/Ad.hs
+++ b/src/View/Html/Ad.hs
@@ -32,11 +32,13 @@ import qualified Model.Detail as D
 import Model.URL
 import Model.Config
 
+import View.Html.Design
+
 renderAds :: Config -> [Ad] -> Text
 renderAds config = toStrict . renderHtml . (adsHtml config)
 
 adsHtml :: Config -> [Ad] -> Html
-adsHtml config ads = H.div (mapM_ (adHtml config) ads)
+adsHtml config ads = do mapM_ (adHtml config) ads
 
 adHtml :: Config -> Ad -> Html
 adHtml config ad =
@@ -47,16 +49,18 @@ adHtml config ad =
         detailHtml config 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
+resumeHtml resume = do
+  H.h1 $ do
+    (toHtml . R.name $ resume)
+    case R.price resume of
+      Just price ->
+        H.span
+          ! A.class_ "price"
+          ! A.style (textValue . toStrict $ priceDesign)
+          $ toHtml price
+      Nothing ->
+        H.span ""
+  linkHtml (R.url resume)
 
 detailHtml :: Config -> Detail -> Html
 detailHtml config detail = do
@@ -70,15 +74,16 @@ detailHtml config detail = do
 
 propertiesHtml :: [Text] -> Map Text Text -> Html
 propertiesHtml keys properties =
-  H.dl $
-    sequence_ $ catMaybes $ map (propertyHtml properties) keys
+  H.dl
+    ! A.style (textValue . toStrict $ dlDesign)
+    $ sequence_ (catMaybes $ map (propertyHtml properties) keys)
 
 propertyHtml :: Map Text Text -> Text -> Maybe Html
 propertyHtml properties key =
   fmap
     (\value -> do
-        H.dt (toHtml key)
-        H.dd (toHtml value)
+        H.dt $ (toHtml key)
+        H.dd ! A.style (textValue . toStrict $ ddDesign) $ (toHtml value)
     )
     (M.lookup key properties)
 
@@ -92,4 +97,6 @@ linkHtml url =
 imageLinkHtml :: URL -> Html
 imageLinkHtml url =
   H.a ! A.href (textValue url) $
-    H.img ! A.src (textValue url)
+    H.img
+      ! A.src (textValue url)
+      ! A.alt (textValue url)
diff --git a/src/View/Html/Design.hs b/src/View/Html/Design.hs
new file mode 100644
index 0000000..c33d991
--- /dev/null
+++ b/src/View/Html/Design.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module View.Html.Design
+  ( dlDesign
+  , ddDesign
+  , priceDesign
+  ) where
+
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import Data.Monoid ((<>))
+
+import Clay
+
+dlDesign :: Text
+dlDesign = inlineRender $ do
+  fontWeight bold
+  fontSize (px 16)
+
+ddDesign :: Text
+ddDesign = inlineRender $ do
+  marginLeft (px 0)
+  marginBottom (px 10)
+  color orangered
+
+priceDesign :: Text
+priceDesign = inlineRender $ do
+  marginLeft (px 10)
+  color orangered
+
+inlineRender :: Css -> Text
+inlineRender =
+  T.dropEnd 1
+  . T.drop 1
+  . renderWith compact []
-- 
cgit v1.2.3