From 0a4d3c8f12dc5797a919a00b6bcaf759947687cc Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Jun 2018 23:24:47 +0200 Subject: Add ouest france parser --- src/View/Html/Ad.hs | 110 ------------------------------------------------ src/View/Html/Design.hs | 40 ------------------ src/View/Plain/Ad.hs | 108 ----------------------------------------------- 3 files changed, 258 deletions(-) delete mode 100644 src/View/Html/Ad.hs delete mode 100644 src/View/Html/Design.hs delete mode 100644 src/View/Plain/Ad.hs (limited to 'src/View') 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) -- cgit v1.2.3