aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.md14
-rw-r--r--leboncoin-listener.cabal1
-rw-r--r--src/AdListener.hs28
-rw-r--r--src/Config.hs25
-rw-r--r--src/Mail.hs21
-rw-r--r--src/Page.hs6
-rw-r--r--src/Utils/Either.hs7
7 files changed, 88 insertions, 14 deletions
diff --git a/README.md b/README.md
index d2ecb93..14458dd 100644
--- a/README.md
+++ b/README.md
@@ -16,9 +16,19 @@ cabal build
Configuration
-------------
-You provide the url you want to listen in a file named conf, for example:
+Provide the url you want to listen to and the mail addresses that will be
+notified in the configuration file:
```
-# This line is a comment
+# The url field is required
url = http://www.leboncoin.fr/locations/offres/ile_de_france/?f=a&th=1
+
+# The mailTo field is an optional list
+# mailTo = jean.dupont@mail.fr, john.smith@mail.com
```
+
+Email
+-----
+
+If you provide mail addresses, leboncoin-listener will try to send mails with
+the sendmail command.
diff --git a/leboncoin-listener.cabal b/leboncoin-listener.cabal
index 2a3789e..0c3123f 100644
--- a/leboncoin-listener.cabal
+++ b/leboncoin-listener.cabal
@@ -13,3 +13,4 @@ executable leboncoin-listener
, time == 1.5.0.1
, HTTP == 4000.2.19
, tagsoup == 0.13.3
+ , MissingH == 1.3.0.1
diff --git a/src/AdListener.hs b/src/AdListener.hs
index 21775cc..da3051d 100644
--- a/src/AdListener.hs
+++ b/src/AdListener.hs
@@ -22,6 +22,8 @@ import View.Ad (renderAds)
import Page
import Parser.Detail
+import Mail (sendMail)
+
import Config (Config)
import qualified Config as C
@@ -35,7 +37,9 @@ listenToNewAds config = do
listenError config [] error
Right resumes ->
let newURLs = map url resumes
- in listenToNewAdsWithViewedURLs config newURLs
+ in do
+ putStrLn "Listening for new ads…"
+ listenToNewAdsWithViewedURLs config newURLs
listenToNewAdsWithViewedURLs :: Config -> [URL] -> IO ()
listenToNewAdsWithViewedURLs config viewedURLs = do
@@ -59,12 +63,32 @@ listenToNewAdsWithResumes config viewedURLs resumes =
time <- getCurrentFormattedTime
if not (null newAds)
then
- T.putStrLn (newAdsMessage time newAds)
+ let message = newAdsMessage time newAds
+ in do
+ T.putStrLn message
+ trySendMail config message
else
return ()
waitOneMinute
listenToNewAdsWithViewedURLs config (viewedURLs ++ newURLs)
+trySendMail :: Config -> Text -> IO ()
+trySendMail config message =
+ case C.mailTo config of
+ Just mailTo ->
+ do
+ eitherMailSuccess <- sendMail mailTo message
+ case eitherMailSuccess of
+ Right () ->
+ return "Mail sent."
+ Left error ->
+ T.putStrLn . T.concat $
+ [ "Error sending mail: "
+ , error
+ ]
+ Nothing ->
+ return ()
+
newAdsMessage :: Text -> [Ad] -> Text
newAdsMessage time newAds =
let newAdsMessage =
diff --git a/src/Config.hs b/src/Config.hs
index 7a44ec0..88eeb1b 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -23,13 +23,24 @@ import Utils.Text
configUsage :: Text
configUsage =
- T.intercalate
- "\n"
- [ T.concat
- [ "Please provide an url for leboncoin in the file named: "
+ T.intercalate "\n"
+ [ ""
+ , T.concat
+ [ " Some information is required in the file `"
, T.pack configPath
+ , "`:"
]
- , "url = http://…"
+ , ""
+ , " - url (required)"
+ , " - mailTo (optional)"
+ , ""
+ , " Example:"
+ , ""
+ , " # The url field is required"
+ , " url = http://www.leboncoin.fr/locations/offres/ile_de_france/?f=a&th=1"
+ , ""
+ , " # The mailTo field is an optional list"
+ , " # mailTo = jean.dupont@mail.fr, john.smith@mail.com"
]
configPath :: FilePath
@@ -37,6 +48,7 @@ configPath = "conf"
data Config = Config
{ url :: URL
+ , mailTo :: Maybe [Text]
} deriving (Eq, Read, Show)
getConfig :: IO (Maybe Config)
@@ -62,7 +74,8 @@ configFromFile =
configFromMap :: Map Text Text -> Maybe Config
configFromMap map = do
url <- M.lookup "url" map
- return $ Config { url = url }
+ let mailTo = T.splitOn "," <$> M.lookup "mailTo" map
+ return $ Config { url = url, mailTo = mailTo }
lineConfig :: Text -> Maybe (Text, Text)
lineConfig line = do
diff --git a/src/Mail.hs b/src/Mail.hs
new file mode 100644
index 0000000..bb96142
--- /dev/null
+++ b/src/Mail.hs
@@ -0,0 +1,21 @@
+module Mail
+ ( sendMail
+ ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Control.Exception (SomeException, try)
+
+import Network.Email.Sendmail (sendmail)
+
+import Utils.Either (mapLeft)
+
+sendMail :: [Text] -> Text -> IO (Either Text ())
+sendMail mailTo body =
+ let from = Just "no-reply@leboncoin-listener.com"
+ in safeSendMail from (map T.unpack $ mailTo) (T.unpack body)
+
+safeSendMail :: Maybe String -> [String] -> String -> IO (Either Text ())
+safeSendMail from to body =
+ mapLeft (T.pack . show) <$> (try (sendmail from to body) :: IO (Either SomeException ()))
diff --git a/src/Page.hs b/src/Page.hs
index da15ce4..443f768 100644
--- a/src/Page.hs
+++ b/src/Page.hs
@@ -11,13 +11,11 @@ import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
import Model.URL
+import Utils.Either (mapLeft)
+
getPage :: URL -> IO (Either Text Text)
getPage url =
mapLeft (T.pack . show) <$> (try (unsafeGetPage url) :: IO (Either SomeException Text))
unsafeGetPage :: URL -> IO Text
unsafeGetPage url = simpleHTTP (getRequest (T.unpack url)) >>= (\x -> T.pack <$> getResponseBody x)
-
-mapLeft :: (a -> c) -> Either a b -> Either c b
-mapLeft f (Left l) = Left (f l)
-mapLeft _ (Right r) = (Right r)
diff --git a/src/Utils/Either.hs b/src/Utils/Either.hs
new file mode 100644
index 0000000..5d62dcc
--- /dev/null
+++ b/src/Utils/Either.hs
@@ -0,0 +1,7 @@
+module Utils.Either
+ ( mapLeft
+ ) where
+
+mapLeft :: (a -> c) -> Either a b -> Either c b
+mapLeft f (Left l) = Left (f l)
+mapLeft _ (Right r) = (Right r)