diff options
| -rw-r--r-- | README.md | 14 | ||||
| -rw-r--r-- | leboncoin-listener.cabal | 1 | ||||
| -rw-r--r-- | src/AdListener.hs | 28 | ||||
| -rw-r--r-- | src/Config.hs | 25 | ||||
| -rw-r--r-- | src/Mail.hs | 21 | ||||
| -rw-r--r-- | src/Page.hs | 6 | ||||
| -rw-r--r-- | src/Utils/Either.hs | 7 |
7 files changed, 88 insertions, 14 deletions
@@ -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) |