{-# 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, catMaybes) import Data.String (fromString) import Data.List (intersperse) import Data.Map (Map) import qualified Data.Map as M 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 import Model.Config renderAds :: Config -> [Ad] -> Text renderAds config = toStrict . renderHtml . (adsHtml config) adsHtml :: Config -> [Ad] -> Html adsHtml config ads = H.div (mapM_ (adHtml config) ads) adHtml :: Config -> Ad -> Html adHtml config ad = let resume = A.resume ad detail = A.detail ad in do resumeHtml resume 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 detailHtml :: Config -> Detail -> Html detailHtml config detail = do propertiesHtml (properties config) (D.properties detail) case D.description detail of Just description -> descriptionHtml description Nothing -> H.div "" mapM_ imageLinkHtml (D.images detail) propertiesHtml :: [Text] -> Map Text Text -> Html propertiesHtml keys properties = H.dl $ 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) ) (M.lookup key properties) 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)