aboutsummaryrefslogtreecommitdiff
path: root/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'src/View')
-rw-r--r--src/View/Html/Ad.hs110
-rw-r--r--src/View/Html/Design.hs40
-rw-r--r--src/View/Plain/Ad.hs108
3 files changed, 0 insertions, 258 deletions
diff --git a/src/View/Html/Ad.hs b/src/View/Html/Ad.hs
deleted file mode 100644
index 53e63bf..0000000
--- a/src/View/Html/Ad.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-{-# 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 (catMaybes)
-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 (Ad)
-import qualified Model.Ad as Ad
-
-import Model.Resume (Resume)
-import qualified Model.Resume as Resume
-
-import Model.Detail (Detail)
-import qualified Model.Detail as Detail
-
-import Model.URL
-import Conf (Conf)
-import qualified Conf
-
-import qualified View.Html.Design as Design
-
-renderAds :: Conf -> [Ad] -> Text
-renderAds conf = toStrict . renderHtml . (adsHtml conf)
-
-adsHtml :: Conf -> [Ad] -> Html
-adsHtml conf ads = do mapM_ (adHtml conf) ads
-
-adHtml :: Conf -> Ad -> Html
-adHtml conf ad =
- let resume = Ad.resume ad
- detail = Ad.detail ad
- in do
- resumeHtml resume
- detailHtml conf detail
-
-resumeHtml :: Resume -> Html
-resumeHtml resume = do
- H.h1 $ do
- (toHtml . Resume.name $ resume)
- case Resume.price resume of
- Just price ->
- H.span
- ! A.class_ "price"
- ! A.style (textValue . toStrict $ Design.price)
- $ toHtml price
- Nothing ->
- H.span ""
- if Resume.isPro resume
- then
- H.span
- ! A.class_ "pro"
- ! A.style (textValue . toStrict $ Design.pro)
- $ "PRO"
- else
- ""
- linkHtml (Resume.url resume)
-
-detailHtml :: Conf -> Detail -> Html
-detailHtml conf detail = do
- propertiesHtml (Conf.properties conf) (Detail.properties detail)
- case Detail.description detail of
- Just description ->
- descriptionHtml description
- Nothing ->
- H.div ""
- mapM_ imageLinkHtml (Detail.images detail)
-
-propertiesHtml :: [Text] -> Map Text Text -> Html
-propertiesHtml keys properties =
- H.dl
- ! A.style (textValue . toStrict $ Design.definitionList)
- $ 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 $ Design.definitionDescription) $ (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)
diff --git a/src/View/Html/Design.hs b/src/View/Html/Design.hs
deleted file mode 100644
index 662c4d0..0000000
--- a/src/View/Html/Design.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Html.Design
- ( definitionList
- , definitionDescription
- , price
- , pro
- ) where
-
-import Data.Text.Lazy (Text)
-import qualified Data.Text.Lazy as T
-
-import Clay
-
-definitionList :: Text
-definitionList = inlineRender $ do
- fontWeight bold
- fontSize (px 16)
-
-definitionDescription :: Text
-definitionDescription = inlineRender $ do
- marginLeft (px 0)
- marginBottom (px 10)
- color orangered
-
-pro :: Text
-pro = inlineRender $ do
- marginLeft (px 10)
- color (rgb 122 179 88)
-
-price :: Text
-price = inlineRender $ do
- marginLeft (px 10)
- color orangered
-
-inlineRender :: Css -> Text
-inlineRender =
- T.dropEnd 1
- . T.drop 1
- . renderWith compact []
diff --git a/src/View/Plain/Ad.hs b/src/View/Plain/Ad.hs
deleted file mode 100644
index b9e980e..0000000
--- a/src/View/Plain/Ad.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Plain.Ad
- ( renderConsoleAds
- , renderAds
- ) where
-
-import Data.Maybe (fromMaybe, catMaybes)
-import Data.Map (Map)
-import qualified Data.Map as M
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Model.Ad (Ad)
-import qualified Model.Ad as Ad
-
-import Model.Resume (Resume)
-import qualified Model.Resume as Resume
-
-import Model.Detail (Detail)
-import qualified Model.Detail as Detail
-
-import Model.URL (URL)
-import Conf (Conf)
-import qualified Conf
-
-renderConsoleAds :: Conf -> Text -> [Ad] -> Text
-renderConsoleAds conf time ads =
- let (title, message) = renderAds conf ads
- titleWithTime =
- T.concat
- [ "\n["
- , time
- , "] "
- , title
- ]
- line = T.map (\_ -> '-') titleWithTime
- in T.intercalate
- "\n"
- [ titleWithTime
- , line
- , ""
- , message
- ]
-
-renderAds :: Conf -> [Ad] -> (Text, Text)
-renderAds conf ads =
- let titleMessage = renderTitle $ length ads
- adsMessage = T.intercalate "\n\n" . map (renderAd conf) $ ads
- in (titleMessage, adsMessage)
-
-renderTitle :: Int -> Text
-renderTitle count =
- T.concat
- [ T.pack . show $ count
- , agreement " nouvelle"
- , agreement " annonce"
- ]
- where agreement word =
- T.concat
- [ word
- , if count > 1 then "s" else ""
- ]
-
-renderAd :: Conf -> Ad -> Text
-renderAd conf ad =
- T.concat
- [ renderResume (Ad.resume ad)
- , "\n"
- , renderDetail conf (Ad.detail ad)
- ]
-
-renderResume :: Resume -> Text
-renderResume resume =
- let formatPrice price = T.concat [" - ", price]
- getPrice = fromMaybe "" . fmap formatPrice . Resume.price $ resume
- isPro = if Resume.isPro resume then " - PRO" else ""
- titleLine = T.concat [Resume.name resume, getPrice, isPro]
- in T.intercalate "\n" [titleLine, Resume.url resume]
-
-renderDetail :: Conf -> Detail -> Text
-renderDetail conf detail =
- T.concat
- [ renderProperties (Conf.properties conf) (Detail.properties detail)
- , fromMaybe "−" (Detail.description detail)
- , renderURLs "\n\nImages:" (Detail.images detail)
- ]
-
-renderProperties :: [Text] -> Map Text Text -> Text
-renderProperties [] _ = ""
-renderProperties keys properties =
- T.concat
- [ "\n"
- , T.concat (catMaybes $ map (renderProperty properties) keys)
- , "\n"
- ]
-
-renderProperty :: Map Text Text -> Text -> Maybe Text
-renderProperty properties key =
- fmap
- (\value -> T.concat [key, ": ", value, "\n"])
- (M.lookup key properties)
-
-renderURLs :: Text -> [URL] -> Text
-renderURLs _ [] = ""
-renderURLs title urls =
- T.intercalate "\n" (title:urls)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-08 12:35:53 +0000