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