diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Config.hs | 10 | ||||
-rw-r--r-- | src/Main.hs | 12 | ||||
-rw-r--r-- | src/Model/Config.hs | 1 | ||||
-rw-r--r-- | src/View/Html/Ad.hs | 39 | ||||
-rw-r--r-- | src/View/Html/Design.hs | 35 |
5 files changed, 69 insertions, 28 deletions
diff --git a/src/Config.hs b/src/Config.hs index 0a421fa..98e2c9a 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -12,6 +12,7 @@ import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T +import Data.Text.Read (decimal) import Control.Monad (guard) @@ -35,6 +36,7 @@ configUsage = , " - url (required)" , " - mailTo (optional)" , " - properties (optional)" + , " - waitInMinutes (optional, default to 1)" , "" , " Example:" , "" @@ -46,6 +48,9 @@ configUsage = , "" , " # The properties field is an optional list" , " # properties = cp, city, surface, ges" + , "" + , " # The waitInMinutes field is an optional integer, default to 1" + , " # waitInMinutes = 60" ] configPath :: FilePath @@ -79,9 +84,14 @@ configFromMap map = do { url = url , mailTo = fieldValues "mailTo" map , properties = fieldValues "properties" map + , waitInMinutes = fromMaybe 1 $ M.lookup "waitInMinutes" map >>= fmap fst . eitherToMaybe . decimal } return config +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe (Right x) = Just x +eitherToMaybe _ = Nothing + fieldValues :: Text -> Map Text Text -> [Text] fieldValues field map = fromMaybe [] $ fmap T.strip . T.splitOn "," <$> M.lookup field map diff --git a/src/Main.hs b/src/Main.hs index 82135a2..f38646b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -19,15 +19,3 @@ main = do listenToNewAds config Nothing -> T.putStrLn C.configUsage - --- import Page --- import Parser.Detail - --- main :: IO () --- main = do --- eitherPage <- getPage "http://www.leboncoin.fr/locations/794858813.htm?ca=18_s" --- case eitherPage of --- Right page -> --- putStrLn (show $ parseDetail page) --- Left error -> --- T.putStrLn error diff --git a/src/Model/Config.hs b/src/Model/Config.hs index 42b390e..8fb05b9 100644 --- a/src/Model/Config.hs +++ b/src/Model/Config.hs @@ -10,4 +10,5 @@ data Config = Config { url :: URL , mailTo :: [Text] , properties :: [Text] + , waitInMinutes :: Int } deriving (Eq, Read, Show) diff --git a/src/View/Html/Ad.hs b/src/View/Html/Ad.hs index f3d9ece..2d6bdb5 100644 --- a/src/View/Html/Ad.hs +++ b/src/View/Html/Ad.hs @@ -32,11 +32,13 @@ 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 = H.div (mapM_ (adHtml config) ads) +adsHtml config ads = do mapM_ (adHtml config) ads adHtml :: Config -> Ad -> Html adHtml config ad = @@ -47,16 +49,18 @@ adHtml config ad = 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 +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 @@ -70,15 +74,16 @@ detailHtml config detail = do propertiesHtml :: [Text] -> Map Text Text -> Html propertiesHtml keys properties = - H.dl $ - sequence_ $ catMaybes $ map (propertyHtml properties) keys + 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 (toHtml value) + H.dt $ (toHtml key) + H.dd ! A.style (textValue . toStrict $ ddDesign) $ (toHtml value) ) (M.lookup key properties) @@ -92,4 +97,6 @@ linkHtml url = imageLinkHtml :: URL -> Html imageLinkHtml url = H.a ! A.href (textValue url) $ - H.img ! A.src (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 new file mode 100644 index 0000000..c33d991 --- /dev/null +++ b/src/View/Html/Design.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + +module View.Html.Design + ( dlDesign + , ddDesign + , priceDesign + ) where + +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy as T +import Data.Monoid ((<>)) + +import Clay + +dlDesign :: Text +dlDesign = inlineRender $ do + fontWeight bold + fontSize (px 16) + +ddDesign :: Text +ddDesign = inlineRender $ do + marginLeft (px 0) + marginBottom (px 10) + color orangered + +priceDesign :: Text +priceDesign = inlineRender $ do + marginLeft (px 10) + color orangered + +inlineRender :: Css -> Text +inlineRender = + T.dropEnd 1 + . T.drop 1 + . renderWith compact [] |