aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/AdListener.hs52
-rw-r--r--src/Mail.hs17
-rw-r--r--src/View/Ad.hs42
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 =