blob: 2d6bdb523ab538081fa9737ff981b17a4d2ced32 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# 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
import View.Html.Design
renderAds :: Config -> [Ad] -> Text
renderAds config = toStrict . renderHtml . (adsHtml config)
adsHtml :: Config -> [Ad] -> Html
adsHtml config ads = do 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 = 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
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
! 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 ! A.style (textValue . toStrict $ ddDesign) $ (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)
! A.alt (textValue url)
|
