From 389d979eb3eaa18beb8a6da9f4a03bdb6acc1722 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sat, 18 Apr 2015 21:59:22 +0200
Subject: Parsing utag_list from a detail page and showing the keys that are
given in the configuration file
---
src/AdListener.hs | 10 +++++-----
src/Config.hs | 24 ++++++++++++++++--------
src/Main.hs | 12 ++++++++++++
src/Model/Config.hs | 13 +++++++++++++
src/Model/Detail.hs | 2 ++
src/Parser/Detail.hs | 40 ++++++++++++++++++++++++++++++++++++---
src/Parser/Utils.hs | 15 ++++++++++-----
src/View/Html/Ad.hs | 38 +++++++++++++++++++++++++++----------
src/View/Plain/Ad.hs | 53 +++++++++++++++++++++++++++++++++++-----------------
9 files changed, 159 insertions(+), 48 deletions(-)
create mode 100644 src/Model/Config.hs
(limited to 'src')
diff --git a/src/AdListener.hs b/src/AdListener.hs
index 4fc9b20..eee2de4 100644
--- a/src/AdListener.hs
+++ b/src/AdListener.hs
@@ -65,7 +65,7 @@ listenToNewAdsWithResumes config viewedURLs resumes =
time <- getCurrentFormattedTime
if not (null newAds)
then
- let message = P.renderConsoleAds time newAds
+ let message = P.renderConsoleAds config time newAds
in do
T.putStrLn message
trySendMail config newAds
@@ -77,11 +77,11 @@ listenToNewAdsWithResumes config viewedURLs resumes =
trySendMail :: Config -> [Ad] -> IO ()
trySendMail config ads =
case C.mailTo config of
- Nothing ->
+ [] ->
return ()
- Just mailTo ->
- let (title, plainBody) = P.renderAds ads
- htmlBody = H.renderAds ads
+ mailTo ->
+ let (title, plainBody) = P.renderAds config ads
+ htmlBody = H.renderAds config ads
in do
eitherMailSuccess <- sendMail mailTo title plainBody htmlBody
case eitherMailSuccess of
diff --git a/src/Config.hs b/src/Config.hs
index 76371be..0a421fa 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -6,7 +6,7 @@ module Config
, getConfig
) where
-import Data.Maybe (catMaybes, isJust)
+import Data.Maybe (catMaybes, isJust, fromMaybe)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
@@ -18,6 +18,7 @@ import Control.Monad (guard)
import System.Directory (doesFileExist)
import Model.URL
+import Model.Config
import Utils.Text
@@ -33,6 +34,7 @@ configUsage =
, ""
, " - url (required)"
, " - mailTo (optional)"
+ , " - properties (optional)"
, ""
, " Example:"
, ""
@@ -41,16 +43,14 @@ configUsage =
, ""
, " # The mailTo field is an optional list"
, " # mailTo = jean.dupont@mail.fr, john.smith@mail.com"
+ , ""
+ , " # The properties field is an optional list"
+ , " # properties = cp, city, surface, ges"
]
configPath :: FilePath
configPath = "conf"
-data Config = Config
- { url :: URL
- , mailTo :: Maybe [Text]
- } deriving (Eq, Read, Show)
-
getConfig :: IO (Maybe Config)
getConfig = do
exists <- doesFileExist configPath
@@ -74,8 +74,16 @@ configFromFile =
configFromMap :: Map Text Text -> Maybe Config
configFromMap map = do
url <- M.lookup "url" map
- let mailTo = fmap T.strip . T.splitOn "," <$> M.lookup "mailTo" map
- return $ Config { url = url, mailTo = mailTo }
+ let config =
+ Config
+ { url = url
+ , mailTo = fieldValues "mailTo" map
+ , properties = fieldValues "properties" map
+ }
+ return config
+
+fieldValues :: Text -> Map Text Text -> [Text]
+fieldValues field map = fromMaybe [] $ fmap T.strip . T.splitOn "," <$> M.lookup field map
lineConfig :: Text -> Maybe (Text, Text)
lineConfig line = do
diff --git a/src/Main.hs b/src/Main.hs
index f38646b..82135a2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -19,3 +19,15 @@ 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
new file mode 100644
index 0000000..42b390e
--- /dev/null
+++ b/src/Model/Config.hs
@@ -0,0 +1,13 @@
+module Model.Config
+ ( Config(..)
+ ) where
+
+import Data.Text
+
+import Model.URL
+
+data Config = Config
+ { url :: URL
+ , mailTo :: [Text]
+ , properties :: [Text]
+ } deriving (Eq, Read, Show)
diff --git a/src/Model/Detail.hs b/src/Model/Detail.hs
index a170ca6..c0e8d5f 100644
--- a/src/Model/Detail.hs
+++ b/src/Model/Detail.hs
@@ -3,10 +3,12 @@ module Model.Detail
) where
import Data.Text
+import Data.Map (Map)
import Model.URL
data Detail = Detail
{ description :: Maybe Text
, images :: [URL]
+ , properties :: Map Text Text
} deriving (Eq, Read, Show)
diff --git a/src/Parser/Detail.hs b/src/Parser/Detail.hs
index 3a91ac2..3f424e9 100644
--- a/src/Parser/Detail.hs
+++ b/src/Parser/Detail.hs
@@ -5,6 +5,11 @@ module Parser.Detail
import Data.Text (Text)
import qualified Data.Text as T
+import Data.Map (Map)
+import qualified Data.Map as M
+
+import Data.Maybe (catMaybes, fromMaybe)
+
import Text.HTML.TagSoup
import Model.Detail
@@ -14,9 +19,11 @@ import Parser.Utils
parseDetail :: Text -> Detail
parseDetail page =
let tags = parseTags page
- description = parseDescription tags
- images = getTagAttributes "" (T.pack "content") tags
- in Detail { description = description, images = images }
+ in Detail
+ { description = parseDescription tags
+ , images = getTagAttributes "" (T.pack "content") tags
+ , properties = parseProperties tags
+ }
parseDescription :: [Tag Text] -> Maybe Text
parseDescription tags =
@@ -27,3 +34,30 @@ parseDescription tags =
else
let replaceBr = map (\tag -> if tag ~== "
" then TagText (T.pack "\n") else tag)
in Just . T.strip . renderTags . replaceBr $ descriptionTags
+
+parseProperties :: [Tag Text] -> Map Text Text
+parseProperties tags =
+ let mbUtagData = getTagTextAfter "