diff options
| -rw-r--r-- | src/AdListener.hs | 52 | ||||
| -rw-r--r-- | src/Mail.hs | 17 | ||||
| -rw-r--r-- | src/View/Ad.hs | 42 |
3 files changed, 70 insertions, 41 deletions
diff --git a/src/AdListener.hs b/src/AdListener.hs index 04e070b..1de56dc 100644 --- a/src/AdListener.hs +++ b/src/AdListener.hs @@ -17,7 +17,7 @@ import Model.Ad import Model.URL import Model.Resume -import View.Ad (renderAds) +import View.Ad import Page import Parser.Detail @@ -63,50 +63,32 @@ listenToNewAdsWithResumes config viewedURLs resumes = time <- getCurrentFormattedTime if not (null newAds) then - let message = newAdsMessage time newAds + let message = renderConsoleAds time newAds in do T.putStrLn message - trySendMail config message + trySendMail config newAds else return () waitOneMinute listenToNewAdsWithViewedURLs config (viewedURLs ++ newURLs) -trySendMail :: Config -> Text -> IO () -trySendMail config message = +trySendMail :: Config -> [Ad] -> IO () +trySendMail config ads = case C.mailTo config of - Just mailTo -> - do - eitherMailSuccess <- sendMail mailTo message - case eitherMailSuccess of - Right () -> - putStrLn "Mail sent." - Left error -> - T.putStrLn . T.concat $ - [ "Error sending mail: " - , error - ] Nothing -> return () - -newAdsMessage :: Text -> [Ad] -> Text -newAdsMessage time newAds = - let newAdsMessage = - T.concat - [ "\nAt " - , time - , ", got " - , T.pack . show . length $ newAds - , " new ad" - , if length newAds > 1 then "s" else "" - ] - line = T.map (\_ -> '-') newAdsMessage - in T.intercalate - "\n" - [ newAdsMessage - , T.concat [line, "\n"] - , renderAds newAds - ] + Just mailTo -> + let (title, message) = renderAds ads + in do + eitherMailSuccess <- sendMail mailTo title message + case eitherMailSuccess of + Right () -> + putStrLn "\nMail sent." + Left error -> + T.putStrLn . T.concat $ + [ "\nError sending mail: " + , error + ] listenError :: Config -> [URL] -> Text -> IO () listenError config viewedURLs error = do diff --git a/src/Mail.hs b/src/Mail.hs index bb96142..5fc2f24 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Mail ( sendMail ) where @@ -11,10 +13,19 @@ import Network.Email.Sendmail (sendmail) import Utils.Either (mapLeft) -sendMail :: [Text] -> Text -> IO (Either Text ()) -sendMail mailTo body = +sendMail :: [Text] -> Text -> Text -> IO (Either Text ()) +sendMail mailTo subject message = let from = Just "no-reply@leboncoin-listener.com" - in safeSendMail from (map T.unpack $ mailTo) (T.unpack body) + in safeSendMail from (map T.unpack $ mailTo) (T.unpack $ makeBody subject message) + +makeBody :: Text -> Text -> Text +makeBody subject message = + T.concat + [ "Subject: " + , subject + , "\n\n" + , message + ] safeSendMail :: Maybe String -> [String] -> String -> IO (Either Text ()) safeSendMail from to body = diff --git a/src/View/Ad.hs b/src/View/Ad.hs index 6f094ee..acf0839 100644 --- a/src/View/Ad.hs +++ b/src/View/Ad.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module View.Ad - ( renderAds + ( renderConsoleAds + , renderAds ) where import Data.List (intersperse) @@ -16,8 +17,43 @@ import qualified Model.Resume as Resume import Model.Detail (Detail(..)) import qualified Model.Detail as Detail -renderAds :: [Ad] -> Text -renderAds = T.intercalate "\n\n" . map renderAd +renderConsoleAds :: Text -> [Ad] -> Text +renderConsoleAds time ads = + let (title, message) = renderAds ads + titleWithTime = + T.concat + [ "\n[" + , time + , "] " + , title + ] + line = T.map (\_ -> '-') title + in T.intercalate + "\n" + [ titleWithTime + , line + , "" + , message + ] + +renderAds :: [Ad] -> (Text, Text) +renderAds ads = + let titleMessage = renderTitle $ length ads + adsMessage = T.intercalate "\n\n" . map renderAd $ 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 :: Ad -> Text renderAd ad = |