aboutsummaryrefslogtreecommitdiff
path: root/src/View/Html/Ad.hs
blob: fce164ef4fde37f16d835e9376442f82918fdfd8 (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
{-# 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)